commit 020cd88ca86851b9ca3d3143c398486510402617 · anil.recoil.org/slop

stack/.gitignore

···

       1
       1
       +
       _build

+2 -1

stack/cacheio/cacheio.opam

···

       15
       15
        
         "dune" {>= "3.16"}

     

       16
       16
        
         "eio"

     

       17
       17
        
         "cmdliner" {>= "2.0.0"}

     

       18
       18
       -
         "yojson"

     

       18
       18
       +
         "jsont"

     

       19
       19
       +
         "bytesrw"

     

       19
       20
        
         "ptime"

     

       20
       21
        
         "logs"

     

       21
       22
        
         "fmt"

+2 -1

stack/cacheio/dune-project

···

       24
       24
        
         dune

     

       25
       25
        
         eio

     

       26
       26
        
         (cmdliner (>= 2.0.0))

     

       27
       27
       -
         yojson

     

       27
       27
       +
         jsont

     

       28
       28
       +
         bytesrw

     

       28
       29
        
         ptime

     

       29
       30
        
         logs

     

       30
       31
        
         fmt

+1 -1

stack/cacheio/lib/dune

···

       2
       2
        
        (public_name cacheio)

     

       3
       3
        
        (name cacheio)

     

       4
       4
        
        (modules cacheio flags entry stats range chunk)

     

       5
       5
       -
        (libraries eio eio_main digestif yojson ptime ptime.clock.os logs fmt xdge cstruct))

     

       5
       5
       +
        (libraries eio eio_main digestif jsont jsont.bytesrw ptime ptime.clock.os logs fmt xdge cstruct))

     

       6
       6
        
       

     

       7
       7
        
       (library

     

       8
       8
        
        (public_name cacheio.cmd)

+23 -1

stack/cacheio/lib/entry.ml

···

       45
       45
        
           (match t.ttl with

     

       46
       46
        
            | None -> "never"

     

       47
       47
        
            | Some exp -> Printf.sprintf "%.1f" exp)

     

       48
       48
       -
           Flags.pp t.flags
     

       48
       48
       +
           Flags.pp t.flags

     

       49
       49
       +
       

     

       50
       50
       +
       (* Jsont support *)

     

       51
       51
       +
       

     

       52
       52
       +
       (* Helper codec for int64 *)

     

       53
       53
       +
       let int64_jsont =

     

       54
       54
       +
         let kind = "Int64" in

     

       55
       55
       +
         let doc = "64-bit integer as number" in

     

       56
       56
       +
         let dec n = Int64.of_float n in

     

       57
       57
       +
         let enc i = Int64.to_float i in

     

       58
       58
       +
         Jsont.map ~kind ~doc ~dec ~enc Jsont.number

     

       59
       59
       +
       

     

       60
       60
       +
       let jsont =

     

       61
       61
       +
         let kind = "Entry" in

     

       62
       62
       +
         let doc = "A cache entry" in

     

       63
       63
       +
         let make key size mtime ttl flags = { key; size; mtime; ttl; flags } in

     

       64
       64
       +
         Jsont.Object.map ~kind ~doc make

     

       65
       65
       +
         |> Jsont.Object.mem "key" Jsont.string ~enc:key

     

       66
       66
       +
         |> Jsont.Object.mem "size" int64_jsont ~enc:size

     

       67
       67
       +
         |> Jsont.Object.mem "mtime" Jsont.number ~enc:mtime

     

       68
       68
       +
         |> Jsont.Object.opt_mem "ttl" Jsont.number ~enc:ttl

     

       69
       69
       +
         |> Jsont.Object.mem "flags" Flags.jsont ~enc:flags

     

       70
       70
       +
         |> Jsont.Object.finish

+6 -1

stack/cacheio/lib/entry.mli

···

       53
       53
        
       (** {1 Pretty Printing} *)

     

       54
       54
        
       

     

       55
       55
        
       (** Pretty printer for entries *)

     

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

       56
       56
       +
       val pp : Format.formatter -> t -> unit

     

       57
       57
       +
       

     

       58
       58
       +
       (** {1 JSON Support} *)

     

       59
       59
       +
       

     

       60
       60
       +
       (** Jsont codec for cache entries *)

     

       61
       61
       +
       val jsont : t Jsont.t

+31 -1

stack/cacheio/lib/flags.ml

···

       97
       97
        
                 | `Pinned -> "P"

     

       98
       98
        
                 | `Stale -> "S"

     

       99
       99
        
                 | `Temporary -> "T"

     

       100
       100
       -
                 | `Chunk -> "C") flags))
     

       100
       100
       +
                 | `Chunk -> "C") flags))

     

       101
       101
       +
       

     

       102
       102
       +
       (* Jsont support *)

     

       103
       103
       +
       

     

       104
       104
       +
       (* JSON codec for individual flags - using string representation *)

     

       105
       105
       +
       let flag_jsont =

     

       106
       106
       +
         let kind = "Flag" in

     

       107
       107
       +
         let doc = "A cache entry flag" in

     

       108
       108
       +
         let dec s =

     

       109
       109
       +
           match s with

     

       110
       110
       +
           | "pinned" -> `Pinned

     

       111
       111
       +
           | "stale" -> `Stale

     

       112
       112
       +
           | "temporary" -> `Temporary

     

       113
       113
       +
           | "chunk" -> `Chunk

     

       114
       114
       +
           | _ -> Jsont.Error.msg Jsont.Meta.none "Invalid flag value"

     

       115
       115
       +
         in

     

       116
       116
       +
         let enc = function

     

       117
       117
       +
           | `Pinned -> "pinned"

     

       118
       118
       +
           | `Stale -> "stale"

     

       119
       119
       +
           | `Temporary -> "temporary"

     

       120
       120
       +
           | `Chunk -> "chunk"

     

       121
       121
       +
         in

     

       122
       122
       +
         Jsont.map ~kind ~doc ~dec ~enc Jsont.string

     

       123
       123
       +
       

     

       124
       124
       +
       (* JSON codec for flag set *)

     

       125
       125
       +
       let jsont =

     

       126
       126
       +
         let kind = "Flags" in

     

       127
       127
       +
         let doc = "A set of cache entry flags" in

     

       128
       128
       +
         let dec lst = of_list lst in

     

       129
       129
       +
         let enc t = to_list t in

     

       130
       130
       +
         Jsont.map ~kind ~doc ~dec ~enc (Jsont.list flag_jsont)

+6 -1

stack/cacheio/lib/flags.mli

···

       94
       94
        
       val pp_flag : Format.formatter -> flag -> unit

     

       95
       95
        
       

     

       96
       96
        
       (** Pretty printer for flag sets *)

     

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

       97
       97
       +
       val pp : Format.formatter -> t -> unit

     

       98
       98
       +
       

     

       99
       99
       +
       (** {1 JSON Support} *)

     

       100
       100
       +
       

     

       101
       101
       +
       (** Jsont codec for flags *)

     

       102
       102
       +
       val jsont : t Jsont.t

+26 -1

stack/cacheio/lib/stats.ml

···

       48
       48
        
           t.expired_count

     

       49
       49
        
           t.pinned_count

     

       50
       50
        
           t.stale_count

     

       51
       51
       -
           t.temporary_count
     

       51
       51
       +
           t.temporary_count

     

       52
       52
       +
       

     

       53
       53
       +
       (* Jsont support *)

     

       54
       54
       +
       

     

       55
       55
       +
       (* Helper codec for int64 *)

     

       56
       56
       +
       let int64_jsont =

     

       57
       57
       +
         let kind = "Int64" in

     

       58
       58
       +
         let doc = "64-bit integer as number" in

     

       59
       59
       +
         let dec n = Int64.of_float n in

     

       60
       60
       +
         let enc i = Int64.to_float i in

     

       61
       61
       +
         Jsont.map ~kind ~doc ~dec ~enc Jsont.number

     

       62
       62
       +
       

     

       63
       63
       +
       let jsont =

     

       64
       64
       +
         let kind = "Stats" in

     

       65
       65
       +
         let doc = "Cache statistics" in

     

       66
       66
       +
         let make total_size entry_count expired_count pinned_count stale_count temporary_count =

     

       67
       67
       +
           { total_size; entry_count; expired_count; pinned_count; stale_count; temporary_count }

     

       68
       68
       +
         in

     

       69
       69
       +
         Jsont.Object.map ~kind ~doc make

     

       70
       70
       +
         |> Jsont.Object.mem "total_size" int64_jsont ~enc:total_size

     

       71
       71
       +
         |> Jsont.Object.mem "entry_count" Jsont.int ~enc:entry_count

     

       72
       72
       +
         |> Jsont.Object.mem "expired_count" Jsont.int ~enc:expired_count

     

       73
       73
       +
         |> Jsont.Object.mem "pinned_count" Jsont.int ~enc:pinned_count

     

       74
       74
       +
         |> Jsont.Object.mem "stale_count" Jsont.int ~enc:stale_count

     

       75
       75
       +
         |> Jsont.Object.mem "temporary_count" Jsont.int ~enc:temporary_count

     

       76
       76
       +
         |> Jsont.Object.finish

+6 -1

stack/cacheio/lib/stats.mli

···

       40
       40
        
       (** {1 Pretty Printing} *)

     

       41
       41
        
       

     

       42
       42
        
       (** Pretty printer for statistics *)

     

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

       43
       43
       +
       val pp : Format.formatter -> t -> unit

     

       44
       44
       +
       

     

       45
       45
       +
       (** {1 JSON Support} *)

     

       46
       46
       +
       

     

       47
       47
       +
       (** Jsont codec for cache statistics *)

     

       48
       48
       +
       val jsont : t Jsont.t

+1 -1

stack/immich/dune

···

       1
       1
        
       (library

     

       2
       2
        
        (name immich)

     

       3
       3
        
        (public_name immich)

     

       4
       4
       -
        (libraries eio eio.core requests requests_json_api ezjsonm fmt ptime uri))

     

       4
       4
       +
        (libraries eio eio.core requests requests_json_api jsont jsont.bytesrw fmt ptime uri))

+2 -1

stack/immich/dune-project

···

       13
       13
        
         eio

     

       14
       14
        
         (eio_main (>= 1.0))

     

       15
       15
        
         requests

     

       16
       16
       -
         ezjsonm

     

       16
       16
       +
         jsont

     

       17
       17
       +
         bytesrw

     

       17
       18
        
         fmt

     

       18
       19
        
         ptime

     

       19
       20
        
         uri))

+44 -36

stack/immich/immich.ml

···

       18
       18
        
         birth_date: string option;

     

       19
       19
        
         thumbnail_path: string;

     

       20
       20
        
         is_hidden: bool;

     

       21
       21
       -
       }

     

       22
       22
       -
       

     

       23
       23
       -
       type people_response = {

     

       24
       24
       -
         total: int;

     

       25
       25
       -
         visible: int;

     

       26
       26
       -
         people: person list;

     

       21
       21
       +
         unknown: Jsont.json;

     

       27
       22
        
       }

     

       28
       23
        
       

     

       29
       24
        
       (** {1 Client Creation} *)

     
···

       33
       28
        
         let requests_session = Requests.set_default_header requests_session "x-api-key" api_key in

     

       34
       29
        
         { base_url; api_key; requests_session }

     

       35
       30
        
       

     

       36
       36
       -
       (** {1 JSON Parsing} *)

     

       31
       31
       +
       (** {1 JSON Codecs} *)

     

       37
       32
        
       

     

       38
       38
       -
       (* Parse a single person from JSON *)

     

       39
       39
       -
       let parse_person json =

     

       40
       40
       -
         let open Ezjsonm in

     

       41
       41
       -
         let id = find json ["id"] |> get_string in

     

       42
       42
       -
         let name = find json ["name"] |> get_string in

     

       43
       43
       -
         let birth_date =

     

       44
       44
       -
           try Some (find json ["birthDate"] |> get_string)

     

       45
       45
       -
           with _ -> None

     

       46
       46
       -
         in

     

       47
       47
       -
         let thumbnail_path = find json ["thumbnailPath"] |> get_string in

     

       48
       48
       -
         let is_hidden =

     

       49
       49
       -
           try find json ["isHidden"] |> get_bool

     

       50
       50
       -
           with _ -> false

     

       33
       33
       +
       (* Jsont codec for person *)

     

       34
       34
       +
       let person_jsont =

     

       35
       35
       +
         let make id name birth_date thumbnail_path is_hidden unknown =

     

       36
       36
       +
           { id; name; birth_date; thumbnail_path; is_hidden; unknown }

     

       51
       37
        
         in

     

       52
       52
       -
         { id; name; birth_date; thumbnail_path; is_hidden }

     

       38
       38
       +
         let id p = p.id in

     

       39
       39
       +
         let name p = p.name in

     

       40
       40
       +
         let birth_date p = p.birth_date in

     

       41
       41
       +
         let thumbnail_path p = p.thumbnail_path in

     

       42
       42
       +
         let is_hidden p = p.is_hidden in

     

       43
       43
       +
         let unknown p = p.unknown in

     

       44
       44
       +
         Jsont.Object.map ~kind:"Person" make

     

       45
       45
       +
         |> Jsont.Object.mem "id" Jsont.string ~enc:id

     

       46
       46
       +
         |> Jsont.Object.mem "name" Jsont.string ~enc:name

     

       47
       47
       +
         |> Jsont.Object.opt_mem "birthDate" Jsont.string ~enc:birth_date

     

       48
       48
       +
         |> Jsont.Object.mem "thumbnailPath" Jsont.string ~enc:thumbnail_path

     

       49
       49
       +
         |> Jsont.Object.mem "isHidden" Jsont.bool ~enc:is_hidden

     

       50
       50
       +
         |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown

     

       51
       51
       +
         |> Jsont.Object.finish

     

       53
       52
        
       

     

       54
       54
       -
       (* Parse people response from JSON *)

     

       55
       55
       -
       let parse_people_response json =

     

       56
       56
       -
         let open Ezjsonm in

     

       57
       57
       -
         let total = find json ["total"] |> get_int in

     

       58
       58
       -
         let visible = find json ["visible"] |> get_int in

     

       59
       59
       -
         let people_json = find json ["people"] in

     

       60
       60
       -
         let people = get_list parse_person people_json in

     

       61
       61
       -
         { total; visible; people }

     

       53
       53
       +
       type people_response = {

     

       54
       54
       +
         total: int;

     

       55
       55
       +
         visible: int;

     

       56
       56
       +
         people: person list;

     

       57
       57
       +
         unknown: Jsont.json;

     

       58
       58
       +
       }

     

       62
       59
        
       

     

       63
       63
       -
       (* Parse a list of people from search results *)

     

       64
       64
       -
       let parse_person_list json =

     

       65
       65
       -
         let open Ezjsonm in

     

       66
       66
       -
         get_list parse_person json

     

       60
       60
       +
       (* Jsont codec for people_response *)

     

       61
       61
       +
       let people_response_jsont =

     

       62
       62
       +
         let make total visible people unknown =

     

       63
       63
       +
           { total; visible; people; unknown }

     

       64
       64
       +
         in

     

       65
       65
       +
         let total r = r.total in

     

       66
       66
       +
         let visible r = r.visible in

     

       67
       67
       +
         let people r = r.people in

     

       68
       68
       +
         let unknown r = r.unknown in

     

       69
       69
       +
         Jsont.Object.map ~kind:"PeopleResponse" make

     

       70
       70
       +
         |> Jsont.Object.mem "total" Jsont.int ~enc:total

     

       71
       71
       +
         |> Jsont.Object.mem "visible" Jsont.int ~enc:visible

     

       72
       72
       +
         |> Jsont.Object.mem "people" (Jsont.list person_jsont) ~enc:people

     

       73
       73
       +
         |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown

     

       74
       74
       +
         |> Jsont.Object.finish

     

       67
       75
        
       

     

       68
       76
        
       (** {1 API Functions} *)

     

       69
       77
        
       

     

       70
       78
        
       let fetch_people { base_url; requests_session; _ } =

     

       71
       79
        
         let open Requests_json_api in

     

       72
       80
        
         let url = base_url / "api/people" in

     

       73
       73
       -
         get_json_exn requests_session url parse_people_response

     

       81
       81
       +
         get_json_exn requests_session url people_response_jsont

     

       74
       82
        
       

     

       75
       83
        
       let fetch_person { base_url; requests_session; _ } ~person_id =

     

       76
       84
        
         let open Requests_json_api in

     

       77
       85
        
         let url = base_url / "api/people" / person_id in

     

       78
       78
       -
         get_json_exn requests_session url parse_person

     

       86
       86
       +
         get_json_exn requests_session url person_jsont

     

       79
       87
        
       

     

       80
       88
        
       let download_thumbnail { base_url; requests_session; _ } ~fs ~person_id ~output_path =

     

       81
       89
        
         try

     
···

       104
       112
        
         let open Requests_json_api in

     

       105
       113
        
         let encoded_name = Uri.pct_encode name in

     

       106
       114
        
         let url = sprintf "%s/api/search/person?name=%s" base_url encoded_name in

     

       107
       107
       -
         get_json_exn requests_session url parse_person_list

     

       115
       115
       +
         get_json_exn requests_session url (Jsont.list person_jsont)

stack/immich/immich.mli

···

       16
       16
        
         birth_date: string option;

     

       17
       17
        
         thumbnail_path: string;

     

       18
       18
        
         is_hidden: bool;

     

       19
       19
       +
         unknown: Jsont.json;  (** Unknown/extra JSON fields preserved during parsing *)

     

       19
       20
        
       }

     

       20
       21
        
       

     

       21
       22
        
       (** Type for the people API response *)

     
···

       23
       24
        
         total: int;

     

       24
       25
        
         visible: int;

     

       25
       26
        
         people: person list;

     

       27
       27
       +
         unknown: Jsont.json;  (** Unknown/extra JSON fields preserved during parsing *)

     

       26
       28
        
       }

     

       27
       29
        
       

     

       28
       30
        
       (** {1 Client Creation} *)

+2 -1

stack/immich/immich.opam

···

       9
       9
        
         "eio"

     

       10
       10
        
         "eio_main" {>= "1.0"}

     

       11
       11
        
         "requests"

     

       12
       12
       -
         "ezjsonm"

     

       12
       12
       +
         "jsont"

     

       13
       13
       +
         "bytesrw"

     

       13
       14
        
         "fmt"

     

       14
       15
        
         "ptime"

     

       15
       16
        
         "uri"

+42 -37

stack/karakeep/bin/karakeep_cli.ml

···

       27
       27
        
           let bookmarks =

     

       28
       28
        
             List.filter (fun (b : Karakeep.bookmark) ->

     

       29
       29
        
               (match archived with

     

       30
       30
       -
                | Some true -> b.archived

     

       31
       31
       -
                | Some false -> not b.archived

     

       30
       30
       +
                | Some true -> Karakeep.bookmark_archived b

     

       31
       31
       +
                | Some false -> not (Karakeep.bookmark_archived b)

     

       32
       32
        
                | None -> true) &&

     

       33
       33
        
               (match favourited with

     

       34
       34
       -
                | Some true -> b.favourited

     

       35
       35
       -
                | Some false -> not b.favourited

     

       34
       34
       +
                | Some true -> Karakeep.bookmark_favourited b

     

       35
       35
       +
                | Some false -> not (Karakeep.bookmark_favourited b)

     

       36
       36
        
                | None -> true)

     

       37
       37
        
             ) bookmarks

     

       38
       38
        
           in

     
···

       40
       40
        
           Printf.printf "Found %d bookmarks\n\n" (List.length bookmarks);

     

       41
       41
        
       

     

       42
       42
        
           List.iteri (fun i (b : Karakeep.bookmark) ->

     

       43
       43
       -
             Printf.printf "%d. %s\n" (i + 1) b.url;

     

       44
       44
       -
             (match b.title with

     

       43
       43
       +
             Printf.printf "%d. %s\n" (i + 1) (Karakeep.bookmark_url b);

     

       44
       44
       +
             (match Karakeep.bookmark_title b with

     

       45
       45
        
              | Some title -> Printf.printf "   Title: %s\n" title

     

       46
       46
        
              | None -> ());

     

       47
       47
       -
             Printf.printf "   ID: %s\n" b.id;

     

       48
       48
       -
             Printf.printf "   Created: %s\n" (Ptime.to_rfc3339 b.created_at);

     

       49
       49
       -
             if b.tags <> [] then

     

       50
       50
       -
               Printf.printf "   Tags: %s\n" (String.concat ", " b.tags);

     

       51
       51
       -
             if b.archived then Printf.printf "   [ARCHIVED]\n";

     

       52
       52
       -
             if b.favourited then Printf.printf "   [FAVOURITED]\n";

     

       53
       53
       -
             (match b.summary with

     

       47
       47
       +
             Printf.printf "   ID: %s\n" (Karakeep.bookmark_id b);

     

       48
       48
       +
             Printf.printf "   Created: %s\n" (Ptime.to_rfc3339 (Karakeep.bookmark_created_at b));

     

       49
       49
       +
             let tags = Karakeep.bookmark_tags b in

     

       50
       50
       +
             if tags <> [] then

     

       51
       51
       +
               Printf.printf "   Tags: %s\n" (String.concat ", " tags);

     

       52
       52
       +
             if Karakeep.bookmark_archived b then Printf.printf "   [ARCHIVED]\n";

     

       53
       53
       +
             if Karakeep.bookmark_favourited b then Printf.printf "   [FAVOURITED]\n";

     

       54
       54
       +
             (match Karakeep.bookmark_summary b with

     

       54
       55
        
              | Some s when s <> "" ->

     

       55
       56
        
                  let summary = if String.length s > 100 then String.sub s 0 100 ^ "..." else s in

     

       56
       57
        
                  Printf.printf "   Summary: %s\n" summary

     
···

       79
       80
        
           let client = Karakeep.create ~sw ~env ~api_key ~base_url in

     

       80
       81
        
           let bookmark = Karakeep.fetch_bookmark_details client bookmark_id in

     

       81
       82
        
       

     

       82
       82
       -
           Printf.printf "Bookmark: %s\n" bookmark.url;

     

       83
       83
       -
           Printf.printf "ID: %s\n" bookmark.id;

     

       84
       84
       -
           (match bookmark.title with

     

       83
       83
       +
           Printf.printf "Bookmark: %s\n" (Karakeep.bookmark_url bookmark);

     

       84
       84
       +
           Printf.printf "ID: %s\n" (Karakeep.bookmark_id bookmark);

     

       85
       85
       +
           (match Karakeep.bookmark_title bookmark with

     

       85
       86
        
            | Some title -> Printf.printf "Title: %s\n" title

     

       86
       87
        
            | None -> ());

     

       87
       87
       -
           (match bookmark.note with

     

       88
       88
       +
           (match Karakeep.bookmark_note bookmark with

     

       88
       89
        
            | Some note -> Printf.printf "Note: %s\n" note

     

       89
       90
        
            | None -> ());

     

       90
       90
       -
           Printf.printf "Created: %s\n" (Ptime.to_rfc3339 bookmark.created_at);

     

       91
       91
       -
           (match bookmark.updated_at with

     

       91
       91
       +
           Printf.printf "Created: %s\n" (Ptime.to_rfc3339 (Karakeep.bookmark_created_at bookmark));

     

       92
       92
       +
           (match Karakeep.bookmark_updated_at bookmark with

     

       92
       93
        
            | Some t -> Printf.printf "Updated: %s\n" (Ptime.to_rfc3339 t)

     

       93
       94
        
            | None -> ());

     

       94
       95
        
       

     

       95
       95
       -
           if bookmark.tags <> [] then

     

       96
       96
       -
             Printf.printf "Tags: %s\n" (String.concat ", " bookmark.tags);

     

       96
       96
       +
           let tags = Karakeep.bookmark_tags bookmark in

     

       97
       97
       +
           if tags <> [] then

     

       98
       98
       +
             Printf.printf "Tags: %s\n" (String.concat ", " tags);

     

       97
       99
        
       

     

       98
       98
       -
           if bookmark.archived then Printf.printf "Status: ARCHIVED\n";

     

       99
       99
       -
           if bookmark.favourited then Printf.printf "Status: FAVOURITED\n";

     

       100
       100
       +
           if Karakeep.bookmark_archived bookmark then Printf.printf "Status: ARCHIVED\n";

     

       101
       101
       +
           if Karakeep.bookmark_favourited bookmark then Printf.printf "Status: FAVOURITED\n";

     

       100
       102
        
       

     

       101
       101
       -
           (match bookmark.summary with

     

       103
       103
       +
           (match Karakeep.bookmark_summary bookmark with

     

       102
       104
        
            | Some s when s <> "" -> Printf.printf "\nSummary:\n%s\n" s

     

       103
       105
        
            | _ -> ());

     

       104
       106
        
       

     

       105
       105
       -
           if bookmark.content <> [] then begin

     

       107
       107
       +
           let content = Karakeep.bookmark_content bookmark in

     

       108
       108
       +
           if content <> [] then begin

     

       106
       109
        
             Printf.printf "\nContent metadata:\n";

     

       107
       110
        
             List.iter (fun (k, v) ->

     

       108
       111
        
               if v <> "null" && v <> "" then

     

       109
       112
        
                 Printf.printf "  %s: %s\n" k v

     

       110
       110
       -
             ) bookmark.content

     

       113
       113
       +
             ) content

     

       111
       114
        
           end;

     

       112
       115
        
       

     

       113
       113
       -
           if bookmark.assets <> [] then begin

     

       116
       116
       +
           let assets = Karakeep.bookmark_assets bookmark in

     

       117
       117
       +
           if assets <> [] then begin

     

       114
       118
        
             Printf.printf "\nAssets:\n";

     

       115
       119
        
             List.iter (fun (id, asset_type) ->

     

       116
       120
        
               Printf.printf "  %s (%s)\n" id asset_type;

     

       117
       121
        
               Printf.printf "    URL: %s\n" (Karakeep.get_asset_url client id)

     

       118
       118
       -
             ) bookmark.assets

     

       122
       122
       +
             ) assets

     

       119
       123
        
           end;

     

       120
       124
        
       

     

       121
       125
        
           0

     
···

       154
       158
        
           in

     

       155
       159
        
       

     

       156
       160
        
           Printf.printf "✓ Bookmark created successfully!\n";

     

       157
       157
       -
           Printf.printf "ID: %s\n" bookmark.id;

     

       158
       158
       -
           Printf.printf "URL: %s\n" bookmark.url;

     

       159
       159
       -
           (match bookmark.title with

     

       161
       161
       +
           Printf.printf "ID: %s\n" (Karakeep.bookmark_id bookmark);

     

       162
       162
       +
           Printf.printf "URL: %s\n" (Karakeep.bookmark_url bookmark);

     

       163
       163
       +
           (match Karakeep.bookmark_title bookmark with

     

       160
       164
        
            | Some t -> Printf.printf "Title: %s\n" t

     

       161
       165
        
            | None -> ());

     

       162
       162
       -
           if bookmark.tags <> [] then

     

       163
       163
       -
             Printf.printf "Tags: %s\n" (String.concat ", " bookmark.tags);

     

       166
       166
       +
           let tags = Karakeep.bookmark_tags bookmark in

     

       167
       167
       +
           if tags <> [] then

     

       168
       168
       +
             Printf.printf "Tags: %s\n" (String.concat ", " tags);

     

       164
       169
        
           0

     

       165
       170
        
         with exn ->

     

       166
       171
        
           Printf.eprintf "Error: %s\n" (Printexc.to_string exn);

     
···

       197
       202
        
               (if List.length bookmarks = 1 then "" else "s");

     

       198
       203
        
       

     

       199
       204
        
             List.iteri (fun i (b : Karakeep.bookmark) ->

     

       200
       200
       -
               Printf.printf "%d. %s\n" (i + 1) b.url;

     

       201
       201
       -
               (match b.title with

     

       205
       205
       +
               Printf.printf "%d. %s\n" (i + 1) (Karakeep.bookmark_url b);

     

       206
       206
       +
               (match Karakeep.bookmark_title b with

     

       202
       207
        
                | Some title -> Printf.printf "   Title: %s\n" title

     

       203
       208
        
                | None -> ());

     

       204
       204
       -
               Printf.printf "   ID: %s\n" b.id;

     

       205
       205
       -
               Printf.printf "   Tags: %s\n" (String.concat ", " b.tags);

     

       209
       209
       +
               Printf.printf "   ID: %s\n" (Karakeep.bookmark_id b);

     

       210
       210
       +
               Printf.printf "   Tags: %s\n" (String.concat ", " (Karakeep.bookmark_tags b));

     

       206
       211
        
               Printf.printf "\n"

     

       207
       212
        
             ) bookmarks;

     

       208
       213
        
             0

+1 -1

stack/karakeep/dune

···

       1
       1
        
       (library

     

       2
       2
        
        (name karakeep)

     

       3
       3
        
        (public_name karakeep)

     

       4
       4
       -
        (libraries bushel eio eio.core requests requests_json_api ezjsonm fmt ptime uri logs logs.fmt))

     

       4
       4
       +
        (libraries eio eio.core requests requests_json_api jsont jsont.bytesrw fmt ptime uri logs logs.fmt))

-1

stack/karakeep/dune-project

···

       13
       13
        
         eio

     

       14
       14
        
         (eio_main (>= 1.0))

     

       15
       15
        
         requests

     

       16
       16
       -
         ezjsonm

     

       17
       16
        
         fmt

     

       18
       17
        
         ptime

     

       19
       18
        
         uri

+313 -271

stack/karakeep/karakeep.ml

···

       1
       1
        
       (** Karakeep API client implementation (Eio version) *)

     

       2
       2
        
       

     

       3
       3
       -
       module J = Ezjsonm

     

       4
       4
       -
       

     

       5
       3
        
       let src = Logs.Src.create "karakeepe" ~doc:"Karakeep API client"

     

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

     

       7
       5
        
       

     

       6
       6
       +
       (** RFC 3339 timestamp support for JSON *)

     

       7
       7
       +
       module Rfc3339 = struct

     

       8
       8
       +
         let parse s =

     

       9
       9
       +
           Ptime.of_rfc3339 s |> Result.to_option |> Option.map (fun (t, _, _) -> t)

     

       10
       10
       +
       

     

       11
       11
       +
         let format t = Ptime.to_rfc3339 ~frac_s:6 ~tz_offset_s:0 t

     

       12
       12
       +
         let _pp ppf t = Format.pp_print_string ppf (format t)

     

       13
       13
       +
       

     

       14
       14
       +
         let jsont =

     

       15
       15
       +
           let kind = "RFC 3339 timestamp" in

     

       16
       16
       +
           let dec meta s =

     

       17
       17
       +
             match parse s with

     

       18
       18
       +
             | Some t -> t

     

       19
       19
       +
             | None ->

     

       20
       20
       +
                 Jsont.Error.msgf meta "invalid RFC 3339 timestamp: %S" s

     

       21
       21
       +
           in

     

       22
       22
       +
           let enc = Jsont.Base.enc format in

     

       23
       23
       +
           Jsont.Base.string (Jsont.Base.map ~kind ~dec ~enc ())

     

       24
       24
       +
       end

     

       25
       25
       +
       

     

       26
       26
       +
       (** Unknown JSON fields - used when keeping unknown members *)

     

       27
       27
       +
       let json_mems_empty = Jsont.Object ([], Jsont.Meta.none)

     

       28
       28
       +
       

     

       8
       29
        
       (** Type representing a Karakeep client session *)

     

       9
       30
        
       type 'net t_internal = {

     

       10
       31
        
         api_key: string;

     
···

       19
       40
        
         let http_client = Requests.create ~sw env in

     

       20
       41
        
         { api_key; base_url; http_client }

     

       21
       42
        
       

     

       22
       22
       -
       (** Type representing a Karakeep bookmark *)

     

       23
       23
       -
       type bookmark = {

     

       24
       24
       -
         id: string;

     

       25
       25
       -
         title: string option;

     

       26
       26
       -
         url: string;

     

       27
       27
       -
         note: string option;

     

       28
       28
       -
         created_at: Ptime.t;

     

       29
       29
       -
         updated_at: Ptime.t option;

     

       30
       30
       -
         favourited: bool;

     

       31
       31
       -
         archived: bool;

     

       32
       32
       -
         tags: string list;

     

       33
       33
       -
         tagging_status: string option;

     

       34
       34
       -
         summary: string option;

     

       35
       35
       -
         content: (string * string) list;

     

       36
       36
       -
         assets: (string * string) list;

     

       37
       37
       -
       }

     

       43
       43
       +
       (** Tag type for bookmark tags *)

     

       44
       44
       +
       module Tag = struct

     

       45
       45
       +
         type t = {

     

       46
       46
       +
           name: string;

     

       47
       47
       +
           unknown: Jsont.json;

     

       48
       48
       +
         }

     

       38
       49
        
       

     

       39
       39
       -
       (** Type for Karakeep API response containing bookmarks *)

     

       40
       40
       -
       type bookmark_response = {

     

       41
       41
       -
         total: int;

     

       42
       42
       -
         data: bookmark list;

     

       43
       43
       -
         next_cursor: string option;

     

       44
       44
       -
       }

     

       50
       50
       +
         let make name unknown = { name; unknown }

     

       51
       51
       +
         let name t = t.name

     

       52
       52
       +
         let unknown t = t.unknown

     

       45
       53
        
       

     

       46
       46
       -
       (** Parse a date string to Ptime.t, defaulting to epoch if invalid *)

     

       47
       47
       -
       let parse_date str =

     

       48
       48
       -
         match Ptime.of_rfc3339 str with

     

       49
       49
       -
         | Ok (date, _, _) -> date

     

       50
       50
       -
         | Error _ ->

     

       51
       51
       -
             Fmt.epr "Warning: could not parse date '%s'\n" str;

     

       52
       52
       -
             (* Default to epoch time *)

     

       53
       53
       -
             let span_opt = Ptime.Span.of_d_ps (0, 0L) in

     

       54
       54
       -
             match span_opt with

     

       55
       55
       -
             | None -> failwith "Internal error: couldn't create epoch time span"

     

       56
       56
       -
             | Some span ->

     

       57
       57
       -
               match Ptime.of_span span with

     

       58
       58
       -
               | Some t -> t

     

       59
       59
       -
               | None -> failwith "Internal error: couldn't create epoch time"

     

       54
       54
       +
         let jsont =

     

       55
       55
       +
           let kind = "Tag" in

     

       56
       56
       +
           Jsont.Object.map ~kind make

     

       57
       57
       +
           |> Jsont.Object.mem "name" Jsont.string ~enc:name

     

       58
       58
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown

     

       59
       59
       +
           |> Jsont.Object.finish

     

       60
       60
       +
       end

     

       60
       61
        
       

     

       61
       61
       -
       (** Extract a string field from JSON, returns None if not present or not a string *)

     

       62
       62
       -
       let get_string_opt json path =

     

       63
       63
       -
         try Some (J.find json path |> J.get_string)

     

       64
       64
       -
         with _ -> None

     

       62
       62
       +
       (** Content field pair (key-value from content object) *)

     

       63
       63
       +
       module ContentField = struct

     

       64
       64
       +
         type _t = string * string

     

       65
       65
        
       

     

       66
       66
       -
       (** Extract a string list field from JSON, returns empty list if not present *)

     

       67
       67
       -
       let get_string_list json path =

     

       68
       68
       -
         try

     

       69
       69
       -
           let items_json = J.find json path in

     

       70
       70
       -
           J.get_list (fun tag -> J.find tag ["name"] |> J.get_string) items_json

     

       71
       71
       -
         with _ -> []

     

       66
       66
       +
         let _key (k, _) = k

     

       67
       67
       +
         let _value (_, v) = v

     

       72
       68
        
       

     

       73
       73
       -
       (** Extract a boolean field from JSON, with default value *)

     

       74
       74
       -
       let get_bool_def json path default =

     

       75
       75
       -
         try J.find json path |> J.get_bool

     

       76
       76
       -
         with _ -> default

     

       69
       69
       +
         (* Helper to convert Jsont.json to string *)

     

       70
       70
       +
         let json_to_string = function

     

       71
       71
       +
           | Jsont.String (s, _) -> s

     

       72
       72
       +
           | Jsont.Bool (b, _) -> string_of_bool b

     

       73
       73
       +
           | Jsont.Number (n, _) -> string_of_float n

     

       74
       74
       +
           | Jsont.Null _ -> "null"

     

       75
       75
       +
           | _ -> "complex_value"

     

       77
       76
        
       

     

       78
       78
       -
       (** Parse a single bookmark from Karakeep JSON *)

     

       79
       79
       -
       let parse_bookmark json =

     

       80
       80
       -
         let id =

     

       81
       81
       -
           try J.find json ["id"] |> J.get_string

     

       82
       82
       -
           with e ->

     

       83
       83
       -
             Log.err (fun m -> m "Error parsing bookmark ID: %s@.JSON: %s"

     

       84
       84
       -
               (Printexc.to_string e) (J.value_to_string json));

     

       85
       85
       -
             failwith "Unable to parse bookmark ID"

     

       86
       86
       -
         in

     

       77
       77
       +
         (* Decode from JSON object members *)

     

       78
       78
       +
         let of_json_mems mems =

     

       79
       79
       +
           List.map (fun ((k, _meta), v) -> (k, json_to_string v)) mems

     

       87
       80
        
       

     

       88
       88
       -
         let title =

     

       89
       89
       -
           try Some (J.find json ["title"] |> J.get_string)

     

       90
       90
       -
           with _ -> None

     

       91
       91
       -
         in

     

       81
       81
       +
         (* Encode to JSON object members *)

     

       82
       82
       +
         let to_json_mems fields =

     

       83
       83
       +
           List.map (fun (k, v) -> ((k, Jsont.Meta.none), Jsont.String (v, Jsont.Meta.none))) fields

     

       84
       84
       +
       end

     

       92
       85
        
       

     

       93
       93
       -
         let url =

     

       94
       94
       -
           try J.find json ["url"] |> J.get_string

     

       95
       95
       -
           with _ -> try

     

       96
       96
       -
             J.find json ["content"; "url"] |> J.get_string

     

       97
       97
       -
           with _ -> try

     

       98
       98
       -
             J.find json ["content"; "sourceUrl"] |> J.get_string

     

       99
       99
       -
           with _ ->

     

       100
       100
       -
             match J.find_opt json ["content"; "type"] with

     

       101
       101
       -
             | Some (`String "asset") ->

     

       102
       102
       -
                 (try J.find json ["content"; "sourceUrl"] |> J.get_string

     

       103
       103
       -
                  with _ ->

     

       104
       104
       -
                    (match J.find_opt json ["id"] with

     

       105
       105
       -
                     | Some (`String id) -> "karakeep-asset://" ^ id

     

       106
       106
       -
                     | _ -> failwith "No URL or asset ID found in bookmark"))

     

       107
       107
       -
             | _ ->

     

       108
       108
       -
                 Log.err (fun m -> m "No URL found in bookmark@.JSON structure: %s"

     

       109
       109
       -
                   (J.value_to_string json));

     

       110
       110
       -
                 failwith "No URL found in bookmark"

     

       111
       111
       -
         in

     

       86
       86
       +
       (** Asset type *)

     

       87
       87
       +
       module Asset = struct

     

       88
       88
       +
         type t = {

     

       89
       89
       +
           id: string;

     

       90
       90
       +
           asset_type: string;

     

       91
       91
       +
           unknown: Jsont.json;

     

       92
       92
       +
         }

     

       112
       93
        
       

     

       113
       113
       -
         let note = get_string_opt json ["note"] in

     

       94
       94
       +
         let make id asset_type unknown = { id; asset_type; unknown }

     

       95
       95
       +
         let id t = t.id

     

       96
       96
       +
         let asset_type t = t.asset_type

     

       97
       97
       +
         let unknown t = t.unknown

     

       114
       98
        
       

     

       115
       115
       -
         let created_at =

     

       116
       116
       -
           try J.find json ["createdAt"] |> J.get_string |> parse_date

     

       117
       117
       -
           with _ ->

     

       118
       118
       -
             try J.find json ["created_at"] |> J.get_string |> parse_date

     

       119
       119
       -
             with _ -> failwith "No creation date found"

     

       120
       120
       -
         in

     

       99
       99
       +
         let jsont =

     

       100
       100
       +
           let kind = "Asset" in

     

       101
       101
       +
           Jsont.Object.map ~kind make

     

       102
       102
       +
           |> Jsont.Object.mem "id" Jsont.string ~enc:id

     

       103
       103
       +
           |> Jsont.Object.mem "assetType" Jsont.string ~enc:asset_type

     

       104
       104
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:unknown

     

       105
       105
       +
           |> Jsont.Object.finish

     

       106
       106
       +
       end

     

       121
       107
        
       

     

       122
       122
       -
         let updated_at =

     

       123
       123
       -
           try Some (J.find json ["updatedAt"] |> J.get_string |> parse_date)

     

       124
       124
       -
           with _ ->

     

       125
       125
       -
             try Some (J.find json ["modifiedAt"] |> J.get_string |> parse_date)

     

       126
       126
       -
             with _ -> None

     

       127
       127
       -
         in

     

       108
       108
       +
       (** Karakeep bookmark *)

     

       109
       109
       +
       module Bookmark = struct

     

       110
       110
       +
         type t = {

     

       111
       111
       +
           id: string;

     

       112
       112
       +
           title: string option;

     

       113
       113
       +
           url: string;

     

       114
       114
       +
           note: string option;

     

       115
       115
       +
           created_at: Ptime.t;

     

       116
       116
       +
           updated_at: Ptime.t option;

     

       117
       117
       +
           favourited: bool;

     

       118
       118
       +
           archived: bool;

     

       119
       119
       +
           tags: string list;

     

       120
       120
       +
           tagging_status: string option;

     

       121
       121
       +
           summary: string option;

     

       122
       122
       +
           content: (string * string) list;

     

       123
       123
       +
           assets: (string * string) list;

     

       124
       124
       +
         }

     

       128
       125
        
       

     

       129
       129
       -
         let favourited = get_bool_def json ["favourited"] false in

     

       130
       130
       -
         let archived = get_bool_def json ["archived"] false in

     

       131
       131
       -
         let tags = get_string_list json ["tags"] in

     

       132
       132
       -
         let tagging_status = get_string_opt json ["taggingStatus"] in

     

       133
       133
       -
         let summary = get_string_opt json ["summary"] in

     

       126
       126
       +
         let id t = t.id

     

       127
       127
       +
         let title t = t.title

     

       128
       128
       +
         let url t = t.url

     

       129
       129
       +
         let note t = t.note

     

       130
       130
       +
         let created_at t = t.created_at

     

       131
       131
       +
         let updated_at t = t.updated_at

     

       132
       132
       +
         let favourited t = t.favourited

     

       133
       133
       +
         let archived t = t.archived

     

       134
       134
       +
         let tags t = t.tags

     

       135
       135
       +
         let tagging_status t = t.tagging_status

     

       136
       136
       +
         let summary t = t.summary

     

       137
       137
       +
         let content t = t.content

     

       138
       138
       +
         let assets t = t.assets

     

       134
       139
        
       

     

       135
       135
       -
         let content =

     

       136
       136
       -
           try

     

       137
       137
       -
             let content_json = J.find json ["content"] in

     

       138
       138
       -
             let rec extract_fields acc = function

     

       139
       139
       -
               | [] -> acc

     

       140
       140
       -
               | (k, v) :: rest ->

     

       141
       141
       -
                   let value = match v with

     

       142
       142
       -
                     | `String s -> s

     

       143
       143
       -
                     | `Bool b -> string_of_bool b

     

       144
       144
       -
                     | `Float f -> string_of_float f

     

       145
       145
       -
                     | `Null -> "null"

     

       146
       146
       -
                     | _ -> "complex_value"

     

       147
       147
       -
                   in

     

       148
       148
       -
                   extract_fields ((k, value) :: acc) rest

     

       140
       140
       +
         let jsont =

     

       141
       141
       +
           let kind = "Bookmark" in

     

       142
       142
       +
       

     

       143
       143
       +
           (* Constructor for decoding *)

     

       144
       144
       +
           let make id title url note created_at updated_at favourited archived

     

       145
       145
       +
               tag_objs tagging_status summary content_obj assets_objs _unknown =

     

       146
       146
       +
       

     

       147
       147
       +
             (* Extract tag names from tag objects *)

     

       148
       148
       +
             let tags = match tag_objs with

     

       149
       149
       +
               | Some tags -> List.map Tag.name tags

     

       150
       150
       +
               | None -> []

     

       151
       151
       +
             in

     

       152
       152
       +
       

     

       153
       153
       +
             (* Extract content fields from JSON object *)

     

       154
       154
       +
             let content = match content_obj with

     

       155
       155
       +
               | Some (Jsont.Object (mems, _)) -> ContentField.of_json_mems mems

     

       156
       156
       +
               | _ -> []

     

       149
       157
        
             in

     

       150
       150
       -
             match content_json with

     

       151
       151
       -
             | `O fields -> extract_fields [] fields

     

       152
       152
       -
             | _ -> []

     

       153
       153
       -
           with _ -> []

     

       154
       154
       -
         in

     

       155
       158
        
       

     

       156
       156
       -
         let assets =

     

       157
       157
       -
           try

     

       158
       158
       -
             let assets_json = J.find json ["assets"] in

     

       159
       159
       -
             J.get_list (fun asset_json ->

     

       160
       160
       -
               let id = J.find asset_json ["id"] |> J.get_string in

     

       161
       161
       -
               let asset_type =

     

       162
       162
       -
                 try J.find asset_json ["assetType"] |> J.get_string

     

       163
       163
       -
                 with _ -> "unknown"

     

       164
       164
       -
               in

     

       165
       165
       -
               (id, asset_type)

     

       166
       166
       -
             ) assets_json

     

       167
       167
       -
           with _ -> []

     

       168
       168
       -
         in

     

       159
       159
       +
             (* Extract asset tuples *)

     

       160
       160
       +
             let assets = match assets_objs with

     

       161
       161
       +
               | Some asset_list -> List.map (fun a -> (Asset.id a, Asset.asset_type a)) asset_list

     

       162
       162
       +
               | None -> []

     

       163
       163
       +
             in

     

       169
       164
        
       

     

       170
       170
       -
         { id; title; url; note; created_at; updated_at; favourited; archived; tags;

     

       171
       171
       -
           tagging_status; summary; content; assets }

     

       165
       165
       +
             (* Handle URL extraction from content if main URL is missing *)

     

       166
       166
       +
             let url = match url with

     

       167
       167
       +
               | Some u -> u

     

       168
       168
       +
               | None ->

     

       169
       169
       +
                   (* Try to find URL in content *)

     

       170
       170
       +
                   (match List.assoc_opt "url" content with

     

       171
       171
       +
                    | Some u -> u

     

       172
       172
       +
                    | None ->

     

       173
       173
       +
                        (match List.assoc_opt "sourceUrl" content with

     

       174
       174
       +
                         | Some u -> u

     

       175
       175
       +
                         | None ->

     

       176
       176
       +
                             (* Check if it's an asset type *)

     

       177
       177
       +
                             (match List.assoc_opt "type" content with

     

       178
       178
       +
                              | Some "asset" ->

     

       179
       179
       +
                                  (match List.assoc_opt "sourceUrl" content with

     

       180
       180
       +
                                   | Some u -> u

     

       181
       181
       +
                                   | None -> "karakeep-asset://" ^ id)

     

       182
       182
       +
                              | _ -> "unknown://no-url")))

     

       183
       183
       +
             in

     

       184
       184
       +
       

     

       185
       185
       +
             {

     

       186
       186
       +
               id;

     

       187
       187
       +
               title;

     

       188
       188
       +
               url;

     

       189
       189
       +
               note;

     

       190
       190
       +
               created_at;

     

       191
       191
       +
               updated_at;

     

       192
       192
       +
               favourited = Option.value ~default:false favourited;

     

       193
       193
       +
               archived = Option.value ~default:false archived;

     

       194
       194
       +
               tags;

     

       195
       195
       +
               tagging_status;

     

       196
       196
       +
               summary;

     

       197
       197
       +
               content;

     

       198
       198
       +
               assets;

     

       199
       199
       +
             }

     

       200
       200
       +
           in

     

       201
       201
       +
       

     

       202
       202
       +
           Jsont.Object.map ~kind make

     

       203
       203
       +
           |> Jsont.Object.mem "id" Jsont.string ~enc:id

     

       204
       204
       +
           |> Jsont.Object.opt_mem "title" Jsont.string ~enc:title

     

       205
       205
       +
           |> Jsont.Object.opt_mem "url" Jsont.string ~enc:(fun t -> Some t.url)

     

       206
       206
       +
           |> Jsont.Object.opt_mem "note" Jsont.string ~enc:note

     

       207
       207
       +
           |> Jsont.Object.mem "createdAt" Rfc3339.jsont ~enc:created_at

     

       208
       208
       +
           |> Jsont.Object.opt_mem "updatedAt" Rfc3339.jsont ~enc:updated_at

     

       209
       209
       +
           |> Jsont.Object.opt_mem "favourited" Jsont.bool ~enc:(fun t -> Some t.favourited)

     

       210
       210
       +
           |> Jsont.Object.opt_mem "archived" Jsont.bool ~enc:(fun t -> Some t.archived)

     

       211
       211
       +
           |> Jsont.Object.opt_mem "tags" (Jsont.list Tag.jsont)

     

       212
       212
       +
               ~enc:(fun t -> if t.tags = [] then None else

     

       213
       213
       +
                     Some (List.map (fun name -> Tag.make name json_mems_empty) t.tags))

     

       214
       214
       +
           |> Jsont.Object.opt_mem "taggingStatus" Jsont.string ~enc:tagging_status

     

       215
       215
       +
           |> Jsont.Object.opt_mem "summary" Jsont.string ~enc:summary

     

       216
       216
       +
           |> Jsont.Object.opt_mem "content" Jsont.json

     

       217
       217
       +
               ~enc:(fun t -> if t.content = [] then None else

     

       218
       218
       +
                     Some (Jsont.Object (ContentField.to_json_mems t.content, Jsont.Meta.none)))

     

       219
       219
       +
           |> Jsont.Object.opt_mem "assets" (Jsont.list Asset.jsont)

     

       220
       220
       +
               ~enc:(fun t -> if t.assets = [] then None else

     

       221
       221
       +
                     Some (List.map (fun (id, asset_type) ->

     

       222
       222
       +
                       Asset.make id asset_type json_mems_empty) t.assets))

     

       223
       223
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun _ -> json_mems_empty)

     

       224
       224
       +
           |> Jsont.Object.finish

     

       225
       225
       +
       end

     

       226
       226
       +
       

     

       227
       227
       +
       (* Compatibility type aliases and accessors *)

     

       228
       228
       +
       type bookmark = Bookmark.t

     

       229
       229
       +
       let bookmark_id = Bookmark.id

     

       230
       230
       +
       let bookmark_title = Bookmark.title

     

       231
       231
       +
       let bookmark_url = Bookmark.url

     

       232
       232
       +
       let bookmark_note = Bookmark.note

     

       233
       233
       +
       let bookmark_created_at = Bookmark.created_at

     

       234
       234
       +
       let bookmark_updated_at = Bookmark.updated_at

     

       235
       235
       +
       let bookmark_favourited = Bookmark.favourited

     

       236
       236
       +
       let bookmark_archived = Bookmark.archived

     

       237
       237
       +
       let bookmark_tags = Bookmark.tags

     

       238
       238
       +
       let bookmark_tagging_status = Bookmark.tagging_status

     

       239
       239
       +
       let bookmark_summary = Bookmark.summary

     

       240
       240
       +
       let bookmark_content = Bookmark.content

     

       241
       241
       +
       let bookmark_assets = Bookmark.assets

     

       242
       242
       +
       

     

       243
       243
       +
       (** Karakeep API response containing bookmarks *)

     

       244
       244
       +
       module BookmarkResponse = struct

     

       245
       245
       +
         type t = {

     

       246
       246
       +
           total: int;

     

       247
       247
       +
           data: bookmark list;

     

       248
       248
       +
           next_cursor: string option;

     

       249
       249
       +
         }

     

       250
       250
       +
       

     

       251
       251
       +
         let make total data next_cursor = { total; data; next_cursor }

     

       252
       252
       +
         let total t = t.total

     

       253
       253
       +
         let data t = t.data

     

       254
       254
       +
         let next_cursor t = t.next_cursor

     

       255
       255
       +
       

     

       256
       256
       +
         (* Format 1: {total, data, nextCursor} *)

     

       257
       257
       +
         let format1_jsont =

     

       258
       258
       +
           let kind = "BookmarkResponse" in

     

       259
       259
       +
           let make total data next_cursor _unknown =

     

       260
       260
       +
             { total; data; next_cursor }

     

       261
       261
       +
           in

     

       262
       262
       +
           Jsont.Object.map ~kind make

     

       263
       263
       +
           |> Jsont.Object.mem "total" Jsont.int ~enc:total

     

       264
       264
       +
           |> Jsont.Object.mem "data" (Jsont.list Bookmark.jsont) ~enc:data

     

       265
       265
       +
           |> Jsont.Object.opt_mem "nextCursor" Jsont.string ~enc:next_cursor

     

       266
       266
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun _ -> json_mems_empty)

     

       267
       267
       +
           |> Jsont.Object.finish

     

       268
       268
       +
       

     

       269
       269
       +
         (* Format 2: {bookmarks, nextCursor} *)

     

       270
       270
       +
         let format2_jsont =

     

       271
       271
       +
           let kind = "BookmarkResponse" in

     

       272
       272
       +
           let make data next_cursor _unknown =

     

       273
       273
       +
             { total = List.length data; data; next_cursor }

     

       274
       274
       +
           in

     

       275
       275
       +
           Jsont.Object.map ~kind make

     

       276
       276
       +
           |> Jsont.Object.mem "bookmarks" (Jsont.list Bookmark.jsont) ~enc:data

     

       277
       277
       +
           |> Jsont.Object.opt_mem "nextCursor" Jsont.string ~enc:next_cursor

     

       278
       278
       +
           |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:(fun _ -> json_mems_empty)

     

       279
       279
       +
           |> Jsont.Object.finish

     

       280
       280
       +
       end

     

       281
       281
       +
       

     

       282
       282
       +
       (* Compatibility type aliases and accessors *)

     

       283
       283
       +
       type bookmark_response = BookmarkResponse.t

     

       284
       284
       +
       let response_total = BookmarkResponse.total

     

       285
       285
       +
       let response_data = BookmarkResponse.data

     

       286
       286
       +
       let response_next_cursor = BookmarkResponse.next_cursor

     

       172
       287
        
       

     

       173
       288
        
       (** Parse a Karakeep bookmark response - handles multiple API response formats *)

     

       174
       174
       -
       let parse_bookmark_response json =

     

       175
       175
       -
         Log.debug (fun m -> m "Parsing API response: %s" (J.value_to_string json));

     

       289
       289
       +
       let parse_bookmark_response json_str =

     

       290
       290
       +
         Log.debug (fun m -> m "Parsing API response (%d bytes)" (String.length json_str));

     

       176
       291
        
       

     

       177
       292
        
         (* Try format 1: {total: int, data: [...], nextCursor?: string} *)

     

       178
       293
        
         let try_format1 () =

     

       179
       294
        
           Log.debug (fun m -> m "Trying format 1: {total, data, nextCursor}");

     

       180
       180
       -
           let total = J.find json ["total"] |> J.get_int in

     

       181
       181
       -
           let bookmarks_json = J.find json ["data"] in

     

       182
       182
       -
           let data = J.get_list parse_bookmark bookmarks_json in

     

       183
       183
       -
           let next_cursor =

     

       184
       184
       -
             try Some (J.find json ["nextCursor"] |> J.get_string)

     

       185
       185
       -
             with _ -> None

     

       186
       186
       -
           in

     

       187
       187
       -
           Log.debug (fun m -> m "Successfully parsed format 1: %d bookmarks" (List.length data));

     

       188
       188
       -
           { total; data; next_cursor }

     

       295
       295
       +
           match Jsont_bytesrw.decode_string' BookmarkResponse.format1_jsont json_str with

     

       296
       296
       +
           | Ok response ->

     

       297
       297
       +
               Log.debug (fun m -> m "Successfully parsed format 1: %d bookmarks" (List.length response.data));

     

       298
       298
       +
               response

     

       299
       299
       +
           | Error e ->

     

       300
       300
       +
               Log.debug (fun m -> m "Format 1 failed: %s" (Jsont.Error.to_string e));

     

       301
       301
       +
               raise Not_found

     

       189
       302
        
         in

     

       190
       303
        
       

     

       191
       191
       -
         (* Try format 2: {bookmarks: [...], nextCursor?: string} - no total field *)

     

       304
       304
       +
         (* Try format 2: {bookmarks: [...], nextCursor?: string} *)

     

       192
       305
        
         let try_format2 () =

     

       193
       306
        
           Log.debug (fun m -> m "Trying format 2: {bookmarks, nextCursor}");

     

       194
       194
       -
           let bookmarks_json = J.find json ["bookmarks"] in

     

       195
       195
       -
           let data = J.get_list parse_bookmark bookmarks_json in

     

       196
       196
       -
           let next_cursor =

     

       197
       197
       -
             try Some (J.find json ["nextCursor"] |> J.get_string)

     

       198
       198
       -
             with _ -> None

     

       199
       199
       -
           in

     

       200
       200
       -
           (* Calculate total from data length when total field is missing *)

     

       201
       201
       -
           let total = List.length data in

     

       202
       202
       -
           Log.debug (fun m -> m "Successfully parsed format 2: %d bookmarks" total);

     

       203
       203
       -
           { total; data; next_cursor }

     

       204
       204
       -
         in

     

       205
       205
       -
       

     

       206
       206
       -
         (* Try format 3: API error response {error: string, message?: string} *)

     

       207
       207
       -
         let try_error_format () =

     

       208
       208
       -
           Log.debug (fun m -> m "Checking for API error response");

     

       209
       209
       -
           let error = J.find json ["error"] |> J.get_string in

     

       210
       210
       -
           let message =

     

       211
       211
       -
             try J.find json ["message"] |> J.get_string

     

       212
       212
       -
             with _ -> "Unknown error"

     

       213
       213
       -
           in

     

       214
       214
       -
           Log.err (fun m -> m "API returned error: %s - %s" error message);

     

       215
       215
       -
           { total = 0; data = []; next_cursor = None }

     

       307
       307
       +
           match Jsont_bytesrw.decode_string' BookmarkResponse.format2_jsont json_str with

     

       308
       308
       +
           | Ok response ->

     

       309
       309
       +
               Log.debug (fun m -> m "Successfully parsed format 2: %d bookmarks" (List.length response.data));

     

       310
       310
       +
               response

     

       311
       311
       +
           | Error e ->

     

       312
       312
       +
               Log.debug (fun m -> m "Format 2 failed: %s" (Jsont.Error.to_string e));

     

       313
       313
       +
               raise Not_found

     

       216
       314
        
         in

     

       217
       315
        
       

     

       218
       218
       -
         (* Try format 4: Plain array at root level *)

     

       316
       316
       +
         (* Try format 3: Plain array at root level *)

     

       219
       317
        
         let try_array_format () =

     

       220
       220
       -
           Log.debug (fun m -> m "Trying format 4: array at root");

     

       221
       221
       -
           match json with

     

       222
       222
       -
           | `A _ ->

     

       223
       223
       -
               let data = J.get_list parse_bookmark json in

     

       318
       318
       +
           Log.debug (fun m -> m "Trying format 3: array at root");

     

       319
       319
       +
           let array_jsont = Jsont.list Bookmark.jsont in

     

       320
       320
       +
           match Jsont_bytesrw.decode_string' array_jsont json_str with

     

       321
       321
       +
           | Ok data ->

     

       224
       322
        
               Log.debug (fun m -> m "Successfully parsed array format: %d bookmarks" (List.length data));

     

       225
       225
       -
               { total = List.length data; data; next_cursor = None }

     

       226
       226
       -
           | _ -> raise Not_found

     

       323
       323
       +
               BookmarkResponse.make (List.length data) data None

     

       324
       324
       +
           | Error e ->

     

       325
       325
       +
               Log.debug (fun m -> m "Array format failed: %s" (Jsont.Error.to_string e));

     

       326
       326
       +
               raise Not_found

     

       227
       327
        
         in

     

       228
       328
        
       

     

       229
       329
        
         (* Try each format in order *)

     

       230
       330
        
         try try_format1 ()

     

       231
       231
       -
         with _ -> (

     

       331
       331
       +
         with Not_found -> (

     

       232
       332
        
           try try_format2 ()

     

       233
       233
       -
           with _ -> (

     

       234
       234
       -
             try try_error_format ()

     

       235
       235
       -
             with _ -> (

     

       236
       236
       -
               try try_array_format ()

     

       237
       237
       -
               with _ ->

     

       238
       238
       -
                 Log.err (fun m -> m "Failed to parse response in any known format");

     

       239
       239
       -
                 Log.debug (fun m -> m "JSON keys: %s"

     

       240
       240
       -
                   (match json with

     

       241
       241
       -
                    | `O fields -> String.concat ", " (List.map fst fields)

     

       242
       242
       -
                    | _ -> "not an object"));

     

       243
       243
       -
                 { total = 0; data = []; next_cursor = None }

     

       244
       244
       -
             )

     

       333
       333
       +
           with Not_found -> (

     

       334
       334
       +
             try try_array_format ()

     

       335
       335
       +
             with Not_found ->

     

       336
       336
       +
               Log.err (fun m -> m "Failed to parse response in any known format");

     

       337
       337
       +
               Log.debug (fun m -> m "Response preview: %s"

     

       338
       338
       +
                 (if String.length json_str > 200 then String.sub json_str 0 200 ^ "..." else json_str));

     

       339
       339
       +
               BookmarkResponse.make 0 [] None

     

       245
       340
        
           )

     

       246
       341
        
         )

     

       247
       342
        
       

     
···

       277
       372
        
           match Requests_json_api.check_ok response with

     

       278
       373
        
           | Ok body_str ->

     

       279
       374
        
               Log.debug (fun m -> m "Received %d bytes of response data" (String.length body_str));

     

       280
       280
       -
               (try

     

       281
       281
       -
                 let json = J.from_string body_str in

     

       282
       282
       -
                 parse_bookmark_response json

     

       283
       283
       -
               with e ->

     

       284
       284
       -
                 Log.err (fun m -> m "JSON parsing error: %s" (Printexc.to_string e));

     

       285
       285
       -
                 Log.debug (fun m -> m "Response body (first 200 chars): %s"

     

       286
       286
       -
                   (if String.length body_str > 200 then String.sub body_str 0 200 ^ "..." else body_str));

     

       287
       287
       -
                 raise e)

     

       375
       375
       +
               parse_bookmark_response body_str

     

       288
       376
        
           | Error (status_code, _) ->

     

       289
       377
        
               Log.err (fun m -> m "HTTP error %d" status_code);

     

       290
       378
        
               failwith (Fmt.str "HTTP error: %d" status_code)

     
···

       325
       413
        
               | _ -> all_bookmarks

     

       326
       414
        
             in

     

       327
       415
        
       

     

       328
       328
       -
             (* Determine if more pages are available:

     

       329
       329
       -
                - If next_cursor is present, there are definitely more pages

     

       330
       330
       -
                - If no next_cursor and we got fewer items than page_size, we're done

     

       331
       331
       -
                - If no next_cursor and total is reliable (> current count), there may be more *)

     

       416
       416
       +
             (* Determine if more pages are available *)

     

       332
       417
        
             let more_available =

     

       333
       418
        
               match response.next_cursor with

     

       334
       419
        
               | Some _ ->

     
···

       338
       423
        
                   let current_count = List.length all_bookmarks in

     

       339
       424
        
                   let got_full_page = List.length response.data = page_size in

     

       340
       425
        
                   let total_indicates_more = response.total > current_count in

     

       341
       341
       -
                   (* If we got a full page and total indicates more, continue *)

     

       342
       426
        
                   let has_more = got_full_page && total_indicates_more in

     

       343
       427
        
                   if has_more then

     

       344
       428
        
                     Log.debug (fun m -> m "More pages likely available (%d fetched < %d total)"

     
···

       380
       464
        
         let response = Requests.get client.http_client ~headers url in

     

       381
       465
        
         match check_ok response with

     

       382
       466
        
         | Ok body_str ->

     

       383
       383
       -
             let json = J.from_string body_str in

     

       384
       384
       -
             parse_bookmark json

     

       467
       467
       +
             (match Jsont_bytesrw.decode_string' Bookmark.jsont body_str with

     

       468
       468
       +
              | Ok bookmark -> bookmark

     

       469
       469
       +
              | Error e ->

     

       470
       470
       +
                  failwith (Fmt.str "Failed to parse bookmark: %s" (Jsont.Error.to_string e)))

     

       385
       471
        
         | Error (status_code, _) ->

     

       386
       472
        
             failwith (Fmt.str "HTTP error: %d" status_code)

     

       387
       473
        
       

     
···

       405
       491
        
       

     

       406
       492
        
       (** Create a new bookmark in Karakeep with optional tags *)

     

       407
       493
        
       let create_bookmark client ~url ?title ?note ?tags ?(favourited=false) ?(archived=false) () =

     

       494
       494
       +
         let meta = Jsont.Meta.none in

     

       408
       495
        
         let body_obj = [

     

       409
       409
       -
           ("type", `String "link");

     

       410
       410
       -
           ("url", `String url);

     

       411
       411
       -
           ("favourited", `Bool favourited);

     

       412
       412
       -
           ("archived", `Bool archived);

     

       496
       496
       +
           (("type", meta), Jsont.String ("link", meta));

     

       497
       497
       +
           (("url", meta), Jsont.String (url, meta));

     

       498
       498
       +
           (("favourited", meta), Jsont.Bool (favourited, meta));

     

       499
       499
       +
           (("archived", meta), Jsont.Bool (archived, meta));

     

       413
       500
        
         ] in

     

       414
       501
        
       

     

       415
       502
        
         let body_obj = match title with

     

       416
       416
       -
           | Some title_str -> ("title", `String title_str) :: body_obj

     

       503
       503
       +
           | Some title_str -> (("title", meta), Jsont.String (title_str, meta)) :: body_obj

     

       417
       504
        
           | None -> body_obj

     

       418
       505
        
         in

     

       419
       506
        
       

     

       420
       507
        
         let body_obj = match note with

     

       421
       421
       -
           | Some note_str -> ("note", `String note_str) :: body_obj

     

       508
       508
       +
           | Some note_str -> (("note", meta), Jsont.String (note_str, meta)) :: body_obj

     

       422
       509
        
           | None -> body_obj

     

       423
       510
        
         in

     

       424
       511
        
       

     

       425
       425
       -
         let body_json = `O body_obj in

     

       426
       426
       -
         let body_str = J.to_string body_json in

     

       512
       512
       +
         let body_json = Jsont.Object (body_obj, meta) in

     

       513
       513
       +
         let body_str = match Jsont_bytesrw.encode_string' Jsont.json body_json with

     

       514
       514
       +
           | Ok s -> s

     

       515
       515
       +
           | Error e -> failwith (Fmt.str "JSON encoding error: %s" (Jsont.Error.to_string e))

     

       516
       516
       +
         in

     

       427
       517
        
       

     

       428
       518
        
         let headers = Requests.Headers.empty

     

       429
       519
        
           |> Requests.Headers.set "Authorization" ("Bearer " ^ client.api_key)

     
···

       438
       528
        
         let status_code = Requests.Response.status_code response in

     

       439
       529
        
         if status_code = 201 || status_code = 200 then begin

     

       440
       530
        
           let body_str = read_body response in

     

       441
       441
       -
           let json = J.from_string body_str in

     

       442
       442
       -
           let bookmark = parse_bookmark json in

     

       531
       531
       +
           let bookmark = match Jsont_bytesrw.decode_string' Bookmark.jsont body_str with

     

       532
       532
       +
             | Ok b -> b

     

       533
       533
       +
             | Error e -> failwith (Fmt.str "Failed to parse created bookmark: %s" (Jsont.Error.to_string e))

     

       534
       534
       +
           in

     

       443
       535
        
       

     

       444
       536
        
           match tags with

     

       445
       537
        
           | Some tag_list when tag_list <> [] ->

     

       446
       538
        
               let tag_objects = List.map (fun tag_name ->

     

       447
       447
       -
                 `O [("tagName", `String tag_name)]

     

       539
       539
       +
                 Jsont.Object ([(("tagName", meta), Jsont.String (tag_name, meta))], meta)

     

       448
       540
        
               ) tag_list in

     

       449
       541
        
       

     

       450
       450
       -
               let tags_body = `O [("tags", `A tag_objects)] in

     

       451
       451
       -
               let tags_body_str = J.to_string tags_body in

     

       542
       542
       +
               let tags_body = Jsont.Object ([(("tags", meta), Jsont.Array (tag_objects, meta))], meta) in

     

       543
       543
       +
               let tags_body_str = match Jsont_bytesrw.encode_string' Jsont.json tags_body with

     

       544
       544
       +
                 | Ok s -> s

     

       545
       545
       +
                 | Error e -> failwith (Fmt.str "JSON encoding error: %s" (Jsont.Error.to_string e))

     

       546
       546
       +
               in

     

       452
       547
        
       

     

       453
       548
        
               let tags_url = client.base_url / "api/v1/bookmarks" / bookmark.id / "tags" in

     

       454
       549
        
               let tags_body = Requests.Body.of_string Requests.Mime.json tags_body_str in

     
···

       464
       559
        
           let error_body = read_body response in

     

       465
       560
        
           failwith (Fmt.str "Failed to create bookmark. HTTP error: %d. Details: %s" status_code error_body)

     

       466
       561
        
         end

     

       467
       467
       -
       

     

       468
       468
       -
       (** Convert a Karakeep bookmark to Bushel.Link.t compatible structure *)

     

       469
       469
       -
       let to_bushel_link ?base_url bookmark =

     

       470
       470
       -
         let description =

     

       471
       471
       -
           match bookmark.title with

     

       472
       472
       -
           | Some title when title <> "" -> title

     

       473
       473
       -
           | _ ->

     

       474
       474
       -
               let content_title = List.assoc_opt "title" bookmark.content in

     

       475
       475
       -
               match content_title with

     

       476
       476
       -
               | Some title when title <> "" && title <> "null" -> title

     

       477
       477
       -
               | _ -> bookmark.url

     

       478
       478
       -
         in

     

       479
       479
       -
         let date = Ptime.to_date bookmark.created_at in

     

       480
       480
       -
       

     

       481
       481
       -
         let metadata =

     

       482
       482
       -
           (match bookmark.summary with Some s -> [("summary", s)] | None -> []) @

     

       483
       483
       -
           (List.filter_map (fun (id, asset_type) ->

     

       484
       484
       -
             match asset_type with

     

       485
       485
       -
             | "screenshot" | "bannerImage" -> Some (asset_type, id)

     

       486
       486
       -
             | _ -> None

     

       487
       487
       -
           ) bookmark.assets) @

     

       488
       488
       -
           (List.filter_map (fun (k, v) ->

     

       489
       489
       -
             if k = "favicon" && v <> "" && v <> "null" then Some ("favicon", v) else None

     

       490
       490
       -
           ) bookmark.content)

     

       491
       491
       -
         in

     

       492
       492
       -
       

     

       493
       493
       -
         let karakeep =

     

       494
       494
       -
           match base_url with

     

       495
       495
       -
           | Some url ->

     

       496
       496
       -
               Some {

     

       497
       497
       -
                 Bushel.Link.remote_url = url;

     

       498
       498
       -
                 id = bookmark.id;

     

       499
       499
       -
                 tags = bookmark.tags;

     

       500
       500
       -
                 metadata = metadata;

     

       501
       501
       -
               }

     

       502
       502
       -
           | None -> None

     

       503
       503
       -
         in

     

       504
       504
       -
       

     

       505
       505
       -
         let bushel_slugs =

     

       506
       506
       -
           List.filter_map (fun tag ->

     

       507
       507
       -
             if String.starts_with ~prefix:"bushel:" tag then

     

       508
       508
       -
               Some (String.sub tag 7 (String.length tag - 7))

     

       509
       509
       -
             else

     

       510
       510
       -
               None

     

       511
       511
       -
           ) bookmark.tags

     

       512
       512
       -
         in

     

       513
       513
       -
       

     

       514
       514
       -
         let bushel =

     

       515
       515
       -
           if bushel_slugs = [] then None

     

       516
       516
       -
           else Some { Bushel.Link.slugs = bushel_slugs; tags = [] }

     

       517
       517
       -
         in

     

       518
       518
       -
       

     

       519
       519
       -
         { Bushel.Link.url = bookmark.url; date; description; karakeep; bushel }

+23 -28

stack/karakeep/karakeep.mli

···

       19
       19
        
         t

     

       20
       20
        
       

     

       21
       21
        
       (** Type representing a Karakeep bookmark *)

     

       22
       22
       -
       type bookmark = {

     

       23
       23
       -
         id: string;

     

       24
       24
       -
         title: string option;

     

       25
       25
       -
         url: string;

     

       26
       26
       -
         note: string option;

     

       27
       27
       -
         created_at: Ptime.t;

     

       28
       28
       -
         updated_at: Ptime.t option;

     

       29
       29
       -
         favourited: bool;

     

       30
       30
       -
         archived: bool;

     

       31
       31
       -
         tags: string list;

     

       32
       32
       -
         tagging_status: string option;

     

       33
       33
       -
         summary: string option;

     

       34
       34
       -
         content: (string * string) list;

     

       35
       35
       -
         assets: (string * string) list;

     

       36
       36
       -
       }

     

       22
       22
       +
       type bookmark

     

       23
       23
       +
       

     

       24
       24
       +
       (** Bookmark accessors *)

     

       25
       25
       +
       val bookmark_id : bookmark -> string

     

       26
       26
       +
       val bookmark_title : bookmark -> string option

     

       27
       27
       +
       val bookmark_url : bookmark -> string

     

       28
       28
       +
       val bookmark_note : bookmark -> string option

     

       29
       29
       +
       val bookmark_created_at : bookmark -> Ptime.t

     

       30
       30
       +
       val bookmark_updated_at : bookmark -> Ptime.t option

     

       31
       31
       +
       val bookmark_favourited : bookmark -> bool

     

       32
       32
       +
       val bookmark_archived : bookmark -> bool

     

       33
       33
       +
       val bookmark_tags : bookmark -> string list

     

       34
       34
       +
       val bookmark_tagging_status : bookmark -> string option

     

       35
       35
       +
       val bookmark_summary : bookmark -> string option

     

       36
       36
       +
       val bookmark_content : bookmark -> (string * string) list

     

       37
       37
       +
       val bookmark_assets : bookmark -> (string * string) list

     

       37
       38
        
       

     

       38
       39
        
       (** Type for Karakeep API response containing bookmarks *)

     

       39
       39
       -
       type bookmark_response = {

     

       40
       40
       -
         total: int;

     

       41
       41
       -
         data: bookmark list;

     

       42
       42
       -
         next_cursor: string option;

     

       43
       43
       -
       }

     

       40
       40
       +
       type bookmark_response

     

       44
       41
        
       

     

       45
       45
       -
       (** Parse a single bookmark from Karakeep JSON *)

     

       46
       46
       -
       val parse_bookmark : Ezjsonm.value -> bookmark

     

       42
       42
       +
       (** Bookmark response accessors *)

     

       43
       43
       +
       val response_total : bookmark_response -> int

     

       44
       44
       +
       val response_data : bookmark_response -> bookmark list

     

       45
       45
       +
       val response_next_cursor : bookmark_response -> string option

     

       47
       46
        
       

     

       48
       48
       -
       (** Parse a Karakeep bookmark response *)

     

       49
       49
       -
       val parse_bookmark_response : Ezjsonm.value -> bookmark_response

     

       47
       47
       +
       (** Parse a Karakeep bookmark response from a JSON string *)

     

       48
       48
       +
       val parse_bookmark_response : string -> bookmark_response

     

       50
       49
        
       

     

       51
       50
        
       (** Fetch bookmarks from a Karakeep instance with pagination support

     

       52
       51
        
           @param client Karakeep client instance

     
···

       92
       91
        
         t ->

     

       93
       92
        
         string ->

     

       94
       93
        
         bookmark

     

       95
       95
       -
       

     

       96
       96
       -
       (** Convert a Karakeep bookmark to Bushel.Link.t compatible structure

     

       97
       97
       -
           @param base_url Optional base URL of the Karakeep instance (for karakeep_id) *)

     

       98
       98
       -
       val to_bushel_link : ?base_url:string -> bookmark -> Bushel.Link.t

     

       99
       94
        
       

     

       100
       95
        
       (** Fetch an asset from the Karakeep server as a binary string

     

       101
       96
        
           @param client Karakeep client instance

-1

stack/karakeep/karakeep.opam

···

       10
       10
        
         "eio"

     

       11
       11
        
         "eio_main" {>= "1.0"}

     

       12
       12
        
         "requests"

     

       13
       13
       -
         "ezjsonm"

     

       14
       13
        
         "fmt"

     

       15
       14
        
         "ptime"

     

       16
       15
        
         "uri"

+8 -4

stack/peertubee/bin/peertubee_cli.ml

···

       36
       36
        
                  Printf.printf "   Description: %s\n" desc_short

     

       37
       37
        
              | None -> ());

     

       38
       38
        
             Printf.printf "   Published: %s\n" (Ptime.to_rfc3339 v.published_at);

     

       39
       39
       -
             if v.tags <> [] then

     

       40
       40
       -
               Printf.printf "   Tags: %s\n" (String.concat ", " v.tags);

     

       39
       39
       +
             (match v.tags with

     

       40
       40
       +
              | Some tags when tags <> [] ->

     

       41
       41
       +
                  Printf.printf "   Tags: %s\n" (String.concat ", " tags)

     

       42
       42
       +
              | _ -> ());

     

       41
       43
        
             Printf.printf "\n"

     

       42
       44
        
           ) videos;

     

       43
       45
        
           0

     
···

       73
       75
        
           (match video.originally_published_at with

     

       74
       76
        
            | Some t -> Printf.printf "Originally published: %s\n" (Ptime.to_rfc3339 t)

     

       75
       77
        
            | None -> ());

     

       76
       76
       -
           if video.tags <> [] then

     

       77
       77
       -
             Printf.printf "Tags: %s\n" (String.concat ", " video.tags);

     

       78
       78
       +
           (match video.tags with

     

       79
       79
       +
            | Some tags when tags <> [] ->

     

       80
       80
       +
                Printf.printf "Tags: %s\n" (String.concat ", " tags)

     

       81
       81
       +
            | _ -> ());

     

       78
       82
        
           (match Peertubee.thumbnail_url client video with

     

       79
       83
        
            | Some url -> Printf.printf "Thumbnail: %s\n" url

     

       80
       84
        
            | None -> ());

+1 -1

stack/peertubee/dune

···

       1
       1
        
       (library

     

       2
       2
        
        (name peertubee)

     

       3
       3
        
        (public_name peertubee)

     

       4
       4
       -
        (libraries ezjsonm eio eio.core requests requests_json_api ptime fmt))

     

       4
       4
       +
        (libraries jsont jsont.bytesrw eio eio.core requests requests_json_api ptime fmt))

-1

stack/peertubee/dune-project

···

       13
       13
        
         eio

     

       14
       14
        
         (eio_main (>= 1.0))

     

       15
       15
        
         requests

     

       16
       16
       -
         ezjsonm

     

       17
       16
        
         fmt

     

       18
       17
        
         ptime))

+85 -55

stack/peertubee/peertubee.ml

···

       1
       1
        
       (** PeerTube API client implementation (Eio version) *)

     

       2
       2
        
       

     

       3
       3
       -
       module J = Ezjsonm

     

       4
       4
       -
       

     

       5
       3
        
       (** Type representing a PeerTube client *)

     

       6
       4
        
       type 'net t_internal = {

     

       7
       5
        
         base_url: string;

     
···

       25
       23
        
         published_at: Ptime.t;

     

       26
       24
        
         originally_published_at: Ptime.t option;

     

       27
       25
        
         thumbnail_path: string option;

     

       28
       28
       -
         tags: string list;

     

       26
       26
       +
         tags: string list option;

     

       27
       27
       +
         unknown: Jsont.json;

     

       29
       28
        
       }

     

       30
       29
        
       

     

       31
       30
        
       (** Type for PeerTube API response containing videos *)

     

       32
       31
        
       type video_response = {

     

       33
       32
        
         total: int;

     

       34
       33
        
         data: video list;

     

       34
       34
       +
         unknown: Jsont.json;

     

       35
       35
        
       }

     

       36
       36
        
       

     

       37
       37
       -
       (** Parse a date string to Ptime.t, defaulting to epoch if invalid *)

     

       38
       38
       -
       let parse_date str =

     

       39
       39
       -
         match Ptime.of_rfc3339 str with

     

       40
       40
       -
         | Ok (date, _, _) -> date

     

       41
       41
       -
         | Error _ ->

     

       42
       42
       -
             Fmt.epr "Warning: could not parse date '%s'\n" str;

     

       43
       43
       -
             (* Default to epoch time *)

     

       44
       44
       -
             let span_opt = Ptime.Span.of_d_ps (0, 0L) in

     

       45
       45
       -
             match span_opt with

     

       46
       46
       -
             | None -> failwith "Internal error: couldn't create epoch time span"

     

       47
       47
       -
             | Some span ->

     

       48
       48
       -
               match Ptime.of_span span with

     

       49
       49
       -
               | Some t -> t

     

       50
       50
       -
               | None -> failwith "Internal error: couldn't create epoch time"

     

       37
       37
       +
       (** Accessor functions for video *)

     

       38
       38
       +
       let video_id (v : video) = v.id

     

       39
       39
       +
       let video_uuid (v : video) = v.uuid

     

       40
       40
       +
       let video_name (v : video) = v.name

     

       41
       41
       +
       let video_description (v : video) = v.description

     

       42
       42
       +
       let video_url (v : video) = v.url

     

       43
       43
       +
       let video_embed_path (v : video) = v.embed_path

     

       44
       44
       +
       let video_published_at (v : video) = v.published_at

     

       45
       45
       +
       let video_originally_published_at (v : video) = v.originally_published_at

     

       46
       46
       +
       let video_thumbnail_path (v : video) = v.thumbnail_path

     

       47
       47
       +
       let video_tags (v : video) = v.tags

     

       48
       48
       +
       let video_unknown (v : video) = v.unknown

     

       51
       49
        
       

     

       52
       52
       -
       (** Extract a string field from JSON, returns None if not present or not a string *)

     

       53
       53
       -
       let get_string_opt json path =

     

       54
       54
       -
         try Some (J.find json path |> J.get_string)

     

       55
       55
       -
         with _ -> None

     

       50
       50
       +
       (** Accessor functions for video_response *)

     

       51
       51
       +
       let video_response_total (vr : video_response) = vr.total

     

       52
       52
       +
       let video_response_data (vr : video_response) = vr.data

     

       53
       53
       +
       let video_response_unknown (vr : video_response) = vr.unknown

     

       56
       54
        
       

     

       57
       57
       -
       (** Extract a string list field from JSON, returns empty list if not present *)

     

       58
       58
       -
       let get_string_list json path =

     

       59
       59
       -
         try

     

       60
       60
       -
           let tags_json = J.find json path in

     

       61
       61
       -
           J.get_list J.get_string tags_json

     

       62
       62
       -
         with _ -> []

     

       55
       55
       +
       (** RFC3339 timestamp codec *)

     

       56
       56
       +
       module Rfc3339 = struct

     

       57
       57
       +
         let parse s =

     

       58
       58
       +
           Ptime.of_rfc3339 s |> Result.to_option |> Option.map (fun (t, _, _) -> t)

     

       63
       59
        
       

     

       64
       64
       -
       (** Parse a single video from PeerTube JSON *)

     

       65
       65
       -
       let parse_video json =

     

       66
       66
       -
         let id = J.find json ["id"] |> J.get_int in

     

       67
       67
       -
         let uuid = J.find json ["uuid"] |> J.get_string in

     

       68
       68
       -
         let name = J.find json ["name"] |> J.get_string in

     

       69
       69
       -
         let description = get_string_opt json ["description"] in

     

       70
       70
       -
         let url = J.find json ["url"] |> J.get_string in

     

       71
       71
       -
         let embed_path = J.find json ["embedPath"] |> J.get_string in

     

       60
       60
       +
         let format t = Ptime.to_rfc3339 ~frac_s:6 ~tz_offset_s:0 t

     

       61
       61
       +
         let pp ppf t = Format.pp_print_string ppf (format t)

     

       72
       62
        
       

     

       73
       73
       -
         (* Parse dates *)

     

       74
       74
       -
         let published_at =

     

       75
       75
       -
           J.find json ["publishedAt"] |> J.get_string |> parse_date

     

       63
       63
       +
         let jsont =

     

       64
       64
       +
           let kind = "RFC 3339 timestamp" in

     

       65
       65
       +
           let doc = "An RFC 3339 date-time string" in

     

       66
       66
       +
           let dec s =

     

       67
       67
       +
             match parse s with

     

       68
       68
       +
             | Some t -> t

     

       69
       69
       +
             | None ->

     

       70
       70
       +
                 Jsont.Error.msgf Jsont.Meta.none "%s: invalid RFC 3339 timestamp: %S"

     

       71
       71
       +
                   kind s

     

       72
       72
       +
           in

     

       73
       73
       +
           Jsont.map ~kind ~doc ~dec ~enc:format Jsont.string

     

       74
       74
       +
       end

     

       75
       75
       +
       

     

       76
       76
       +
       (** Jsont codec for video *)

     

       77
       77
       +
       let video_jsont : video Jsont.t =

     

       78
       78
       +
         let kind = "PeerTube Video" in

     

       79
       79
       +
         let doc = "A PeerTube video object" in

     

       80
       80
       +
       

     

       81
       81
       +
         let make_video id uuid name description url embed_path published_at

     

       82
       82
       +
                        originally_published_at thumbnail_path tags unknown : video =

     

       83
       83
       +
           { id; uuid; name; description; url; embed_path; published_at;

     

       84
       84
       +
             originally_published_at; thumbnail_path; tags; unknown }

     

       76
       85
        
         in

     

       77
       86
        
       

     

       78
       78
       -
         let originally_published_at =

     

       79
       79
       -
           match get_string_opt json ["originallyPublishedAt"] with

     

       80
       80
       -
           | Some date -> Some (parse_date date)

     

       81
       81
       -
           | None -> None

     

       87
       87
       +
         Jsont.Object.map ~kind ~doc make_video

     

       88
       88
       +
         |> Jsont.Object.mem "id" Jsont.int ~enc:video_id

     

       89
       89
       +
         |> Jsont.Object.mem "uuid" Jsont.string ~enc:video_uuid

     

       90
       90
       +
         |> Jsont.Object.mem "name" Jsont.string ~enc:video_name

     

       91
       91
       +
         |> Jsont.Object.opt_mem "description" Jsont.string ~enc:video_description

     

       92
       92
       +
         |> Jsont.Object.mem "url" Jsont.string ~enc:video_url

     

       93
       93
       +
         |> Jsont.Object.mem "embedPath" Jsont.string ~enc:video_embed_path

     

       94
       94
       +
         |> Jsont.Object.mem "publishedAt" Rfc3339.jsont ~enc:video_published_at

     

       95
       95
       +
         |> Jsont.Object.opt_mem "originallyPublishedAt" Rfc3339.jsont ~enc:video_originally_published_at

     

       96
       96
       +
         |> Jsont.Object.opt_mem "thumbnailPath" Jsont.string ~enc:video_thumbnail_path

     

       97
       97
       +
         |> Jsont.Object.opt_mem "tags" (Jsont.list Jsont.string) ~enc:video_tags

     

       98
       98
       +
         |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:video_unknown

     

       99
       99
       +
         |> Jsont.Object.finish

     

       100
       100
       +
       

     

       101
       101
       +
       (** Jsont codec for video_response *)

     

       102
       102
       +
       let video_response_jsont =

     

       103
       103
       +
         let kind = "PeerTube Video Response" in

     

       104
       104
       +
         let doc = "A PeerTube API response containing videos" in

     

       105
       105
       +
       

     

       106
       106
       +
         let make_response total data unknown =

     

       107
       107
       +
           { total; data; unknown }

     

       82
       108
        
         in

     

       83
       109
        
       

     

       84
       84
       -
         let thumbnail_path = get_string_opt json ["thumbnailPath"] in

     

       85
       85
       -
         let tags = get_string_list json ["tags"] in

     

       110
       110
       +
         Jsont.Object.map ~kind ~doc make_response

     

       111
       111
       +
         |> Jsont.Object.mem "total" Jsont.int ~enc:video_response_total

     

       112
       112
       +
         |> Jsont.Object.mem "data" (Jsont.list video_jsont) ~enc:video_response_data

     

       113
       113
       +
         |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:video_response_unknown

     

       114
       114
       +
         |> Jsont.Object.finish

     

       86
       115
        
       

     

       87
       87
       -
         { id; uuid; name; description; url; embed_path;

     

       88
       88
       -
           published_at; originally_published_at;

     

       89
       89
       -
           thumbnail_path; tags }

     

       116
       116
       +
       (** Parse a single video from JSON string *)

     

       117
       117
       +
       let parse_video_string s =

     

       118
       118
       +
         match Jsont_bytesrw.decode_string' video_jsont s with

     

       119
       119
       +
         | Ok video -> video

     

       120
       120
       +
         | Error err -> failwith (Jsont.Error.to_string err)

     

       90
       121
        
       

     

       91
       91
       -
       (** Parse a PeerTube video response *)

     

       92
       92
       -
       let parse_video_response json =

     

       93
       93
       -
         let total = J.find json ["total"] |> J.get_int in

     

       94
       94
       -
         let videos_json = J.find json ["data"] in

     

       95
       95
       -
         let data = J.get_list parse_video videos_json in

     

       96
       96
       -
         { total; data }

     

       122
       122
       +
       (** Parse a video response from JSON string *)

     

       123
       123
       +
       let parse_video_response_string s =

     

       124
       124
       +
         match Jsont_bytesrw.decode_string' video_response_jsont s with

     

       125
       125
       +
         | Ok response -> response

     

       126
       126
       +
         | Error err -> failwith (Jsont.Error.to_string err)

     

       97
       127
        
       

     

       98
       128
        
       (** Fetch videos from a PeerTube instance channel with pagination support

     

       99
       129
        
           @param count Number of videos to fetch per page

     
···

       105
       135
        
         let open Requests_json_api in

     

       106
       136
        
         let url = Printf.sprintf "%s/api/v1/video-channels/%s/videos?count=%d&start=%d"

     

       107
       137
        
                     client.base_url channel count start in

     

       108
       108
       -
         get_json_exn client.requests_session url parse_video_response

     

       138
       138
       +
         get_json_exn client.requests_session url video_response_jsont

     

       109
       139
        
       

     

       110
       140
        
       (** Fetch all videos from a PeerTube instance channel using pagination

     

       111
       141
        
           @param page_size Number of videos to fetch per page

     
···

       140
       170
        
       let fetch_video_details client uuid =

     

       141
       171
        
         let open Requests_json_api in

     

       142
       172
        
         let url = client.base_url / "api/v1/videos" / uuid in

     

       143
       143
       -
         get_json_exn client.requests_session url parse_video

     

       173
       173
       +
         get_json_exn client.requests_session url video_jsont

     

       144
       174
        
       

     

       145
       175
        
       (** Convert a PeerTube video to Bushel.Video.t compatible structure *)

     

       146
       176
        
       let to_bushel_video video =

+33 -5

stack/peertubee/peertubee.mli

···

       23
       23
        
         published_at: Ptime.t;

     

       24
       24
        
         originally_published_at: Ptime.t option;

     

       25
       25
        
         thumbnail_path: string option;

     

       26
       26
       -
         tags: string list;

     

       26
       26
       +
         tags: string list option;

     

       27
       27
       +
         unknown: Jsont.json;

     

       27
       28
        
       }

     

       28
       29
        
       

     

       29
       30
        
       (** Type for PeerTube API response containing videos *)

     

       30
       31
        
       type video_response = {

     

       31
       32
        
         total: int;

     

       32
       33
        
         data: video list;

     

       34
       34
       +
         unknown: Jsont.json;

     

       33
       35
        
       }

     

       34
       36
        
       

     

       35
       35
       -
       (** Parse a single video from PeerTube JSON *)

     

       36
       36
       -
       val parse_video : Ezjsonm.value -> video

     

       37
       37
       +
       (** Accessor functions for video *)

     

       38
       38
       +
       val video_id : video -> int

     

       39
       39
       +
       val video_uuid : video -> string

     

       40
       40
       +
       val video_name : video -> string

     

       41
       41
       +
       val video_description : video -> string option

     

       42
       42
       +
       val video_url : video -> string

     

       43
       43
       +
       val video_embed_path : video -> string

     

       44
       44
       +
       val video_published_at : video -> Ptime.t

     

       45
       45
       +
       val video_originally_published_at : video -> Ptime.t option

     

       46
       46
       +
       val video_thumbnail_path : video -> string option

     

       47
       47
       +
       val video_tags : video -> string list option

     

       48
       48
       +
       val video_unknown : video -> Jsont.json

     

       37
       49
        
       

     

       38
       38
       -
       (** Parse a PeerTube video response *)

     

       39
       39
       -
       val parse_video_response : Ezjsonm.value -> video_response

     

       50
       50
       +
       (** Accessor functions for video_response *)

     

       51
       51
       +
       val video_response_total : video_response -> int

     

       52
       52
       +
       val video_response_data : video_response -> video list

     

       53
       53
       +
       val video_response_unknown : video_response -> Jsont.json

     

       54
       54
       +
       

     

       55
       55
       +
       (** RFC3339 timestamp handling *)

     

       56
       56
       +
       module Rfc3339 : sig

     

       57
       57
       +
         val parse : string -> Ptime.t option

     

       58
       58
       +
         val format : Ptime.t -> string

     

       59
       59
       +
         val pp : Format.formatter -> Ptime.t -> unit

     

       60
       60
       +
         val jsont : Ptime.t Jsont.t

     

       61
       61
       +
       end

     

       62
       62
       +
       

     

       63
       63
       +
       (** Parse a single video from JSON string *)

     

       64
       64
       +
       val parse_video_string : string -> video

     

       65
       65
       +
       

     

       66
       66
       +
       (** Parse a PeerTube video response from JSON string *)

     

       67
       67
       +
       val parse_video_response_string : string -> video_response

     

       40
       68
        
       

     

       41
       69
        
       (** Fetch videos from a PeerTube instance channel with pagination support

     

       42
       70
        
           @param client The PeerTube client

-1

stack/peertubee/peertubee.opam

···

       10
       10
        
         "eio"

     

       11
       11
        
         "eio_main" {>= "1.0"}

     

       12
       12
        
         "requests"

     

       13
       13
       -
         "ezjsonm"

     

       14
       13
        
         "fmt"

     

       15
       14
        
         "ptime"

     

       16
       15
        
         "odoc" {with-doc}

+1 -1

stack/requests/bin/dune

···

       1
       1
        
       (executables

     

       2
       2
        
        (public_names ocurl)

     

       3
       3
        
        (names ocurl)

     

       4
       4
       -
        (libraries requests eio_main cmdliner logs logs.cli logs.fmt fmt.cli fmt.tty yojson))

     

       4
       4
       +
        (libraries requests eio_main cmdliner logs logs.cli logs.fmt fmt.cli fmt.tty jsont jsont.bytesrw))

+12 -3

stack/requests/bin/ocurl.ml

···

       191
       191
        
               if String.length body_str > 0 &&

     

       192
       192
        
                  (body_str.[0] = '{' || body_str.[0] = '[') then

     

       193
       193
        
                 try

     

       194
       194
       -
                   let json = Yojson.Safe.from_string body_str in

     

       195
       195
       -
                   if not quiet then Fmt.pr "[%s]:@." url_str;

     

       196
       196
       -
                   Fmt.pr "%a@." (Yojson.Safe.pretty_print ~std:true) json

     

       194
       194
       +
                   match Jsont_bytesrw.decode_string' Jsont.json body_str with

     

       195
       195
       +
                   | Ok json ->

     

       196
       196
       +
                       (match Jsont_bytesrw.encode_string' ~format:Jsont.Indent Jsont.json json with

     

       197
       197
       +
                       | Ok pretty ->

     

       198
       198
       +
                           if not quiet then Fmt.pr "[%s]:@." url_str;

     

       199
       199
       +
                           print_string pretty

     

       200
       200
       +
                       | Error _ ->

     

       201
       201
       +
                           if not quiet then Fmt.pr "[%s]:@." url_str;

     

       202
       202
       +
                           print_string body_str)

     

       203
       203
       +
                   | Error _ ->

     

       204
       204
       +
                       if not quiet then Fmt.pr "[%s]:@." url_str;

     

       205
       205
       +
                       print_string body_str

     

       197
       206
        
                 with _ ->

     

       198
       207
        
                   if not quiet then Fmt.pr "[%s]:@." url_str;

     

       199
       208
        
                   print_string body_str

-1

stack/requests/dune-project

···

       25
       25
        
         ca-certs

     

       26
       26
        
         mirage-crypto-rng-eio

     

       27
       27
        
         uri

     

       28
       28
       -
         yojson

     

       29
       28
        
         digestif

     

       30
       29
        
         base64

     

       31
       30
        
         logs))

+28 -150

stack/requests/lib/body.ml

···

       43
       43
        
           (Eio.Path.native_exn file) (Mime.to_string mime));

     

       44
       44
        
         File { file; mime }

     

       45
       45
        
       

     

       46
       46
       -
       type json =

     

       47
       47
       -
         [ `Null | `Bool of bool | `Float of float | `String of string

     

       48
       48
       -
         | `A of json list | `O of (string * json) list ]

     

       49
       49
       -
       

     

       50
       50
       -
       let json json_value =

     

       51
       51
       -
         (* Encode json value to a JSON string *)

     

       52
       52
       -
         let buffer = Buffer.create 1024 in

     

       53
       53
       -
         let encoder = Jsonm.encoder ~minify:true (`Buffer buffer) in

     

       54
       54
       -
       

     

       55
       55
       -
         let enc e l =

     

       56
       56
       -
           match Jsonm.encode e (`Lexeme l) with

     

       57
       57
       -
           | `Ok -> ()

     

       58
       58
       -
           | `Partial -> failwith "Unexpected partial with buffer destination"

     

       46
       46
       +
       (* For simple JSON encoding, we just take a Jsont.json value and encode it *)

     

       47
       47
       +
       let json (json_value : Jsont.json) =

     

       48
       48
       +
         let content = match Jsont_bytesrw.encode_string' ~format:Jsont.Minify Jsont.json json_value with

     

       49
       49
       +
           | Ok s -> s

     

       50
       50
       +
           | Error e ->

     

       51
       51
       +
               let msg = Jsont.Error.to_string e in

     

       52
       52
       +
               failwith (Printf.sprintf "Failed to encode JSON: %s" msg)

     

       59
       53
        
         in

     

       54
       54
       +
         String { content; mime = Mime.json }

     

       60
       55
        
       

     

       61
       61
       -
         let rec encode_value v k e =

     

       62
       62
       -
           match v with

     

       63
       63
       -
           | `A vs -> encode_array vs k e

     

       64
       64
       -
           | `O ms -> encode_object ms k e

     

       65
       65
       -
           | `Null | `Bool _ | `Float _ | `String _ as v -> enc e v; k e

     

       66
       66
       -
         and encode_array vs k e =

     

       67
       67
       -
           enc e `As;

     

       68
       68
       -
           encode_array_values vs k e

     

       69
       69
       -
         and encode_array_values vs k e =

     

       70
       70
       -
           match vs with

     

       71
       71
       -
           | v :: vs' -> encode_value v (encode_array_values vs' k) e

     

       72
       72
       -
           | [] -> enc e `Ae; k e

     

       73
       73
       -
         and encode_object ms k e =

     

       74
       74
       -
           enc e `Os;

     

       75
       75
       -
           encode_object_members ms k e

     

       76
       76
       -
         and encode_object_members ms k e =

     

       77
       77
       -
           match ms with

     

       78
       78
       -
           | (n, v) :: ms' ->

     

       79
       79
       -
               enc e (`Name n);

     

       80
       80
       -
               encode_value v (encode_object_members ms' k) e

     

       81
       81
       -
           | [] -> enc e `Oe; k e

     

       82
       82
       -
         in

     

       83
       83
       -
       

     

       84
       84
       -
         let finish e =

     

       85
       85
       -
           match Jsonm.encode e `End with

     

       86
       86
       -
           | `Ok -> ()

     

       87
       87
       -
           | `Partial -> failwith "Unexpected partial at end"

     

       88
       88
       -
         in

     

       89
       89
       -
       

     

       90
       90
       -
         encode_value json_value finish encoder;

     

       91
       91
       -
       

     

       92
       92
       -
         String { content = Buffer.contents buffer; mime = Mime.json }

     

       93
       93
       -
       

     

       56
       56
       +
       (* JSON streaming using jsont - we encode the value to string and stream it *)

     

       94
       57
        
       module Json_stream_source = struct

     

       95
       95
       -
         type encode_state =

     

       96
       96
       -
           | Ready              (* Ready to encode new lexemes *)

     

       97
       97
       -
           | NeedAwait          (* Need to send `Await after previous `Partial *)

     

       98
       98
       -
           | Finished           (* All done *)

     

       99
       99
       -
       

     

       100
       58
        
         type t = {

     

       101
       101
       -
           encoder : Jsonm.encoder;

     

       102
       102
       -
           mutable buffer : bytes;

     

       103
       103
       -
           mutable buffer_offset : int;

     

       104
       104
       -
           mutable buffer_len : int;

     

       105
       105
       -
           mutable pending_lexemes : Jsonm.lexeme Queue.t;

     

       106
       106
       -
           mutable encode_state : encode_state;

     

       107
       107
       -
           mutable end_signaled : bool;

     

       108
       108
       -
           writer : (Jsonm.lexeme -> unit) -> unit;

     

       59
       59
       +
           mutable content : string;

     

       60
       60
       +
           mutable offset : int;

     

       109
       61
        
         }

     

       110
       62
        
       

     

       111
       111
       -
         let rec single_read t dst =

     

       112
       112
       -
           if t.encode_state = Finished && t.buffer_offset >= t.buffer_len then

     

       63
       63
       +
         let single_read t dst =

     

       64
       64
       +
           if t.offset >= String.length t.content then

     

       113
       65
        
             raise End_of_file

     

       114
       114
       -
           else if t.buffer_offset < t.buffer_len then begin

     

       115
       115
       -
             (* We have data in buffer to copy *)

     

       116
       116
       -
             let available = t.buffer_len - t.buffer_offset in

     

       66
       66
       +
           else begin

     

       67
       67
       +
             let available = String.length t.content - t.offset in

     

       117
       68
        
             let to_copy = min (Cstruct.length dst) available in

     

       118
       118
       -
             Cstruct.blit_from_bytes t.buffer t.buffer_offset dst 0 to_copy;

     

       119
       119
       -
             t.buffer_offset <- t.buffer_offset + to_copy;

     

       69
       69
       +
             Cstruct.blit_from_string t.content t.offset dst 0 to_copy;

     

       70
       70
       +
             t.offset <- t.offset + to_copy;

     

       120
       71
        
             to_copy

     

       121
       121
       -
           end else begin

     

       122
       122
       -
             (* Buffer empty, need to generate more data *)

     

       123
       123
       -
             t.buffer_offset <- 0;

     

       124
       124
       -
             t.buffer_len <- 0;

     

       125
       125
       -
             Jsonm.Manual.dst t.encoder t.buffer 0 (Bytes.length t.buffer);

     

       126
       126
       -
       

     

       127
       127
       -
             let rec process_encoding () =

     

       128
       128
       -
               match t.encode_state with

     

       129
       129
       -
               | NeedAwait ->

     

       130
       130
       -
                   (* Send `Await after previous `Partial *)

     

       131
       131
       -
                   (match Jsonm.encode t.encoder `Await with

     

       132
       132
       -
                    | `Ok ->

     

       133
       133
       -
                        t.encode_state <- Ready;

     

       134
       134
       -
                        process_encoding ()

     

       135
       135
       -
                    | `Partial ->

     

       136
       136
       -
                        t.buffer_len <- Bytes.length t.buffer - Jsonm.Manual.dst_rem t.encoder)

     

       137
       137
       -
               | Ready when not (Queue.is_empty t.pending_lexemes) ->

     

       138
       138
       -
                   (* Encode next lexeme *)

     

       139
       139
       -
                   let lexeme = Queue.take t.pending_lexemes in

     

       140
       140
       -
                   (match Jsonm.encode t.encoder (`Lexeme lexeme) with

     

       141
       141
       -
                    | `Ok ->

     

       142
       142
       -
                        (* Successfully encoded, continue with next *)

     

       143
       143
       -
                        process_encoding ()

     

       144
       144
       -
                    | `Partial ->

     

       145
       145
       -
                        (* Buffer full, need to flush and await

     

       146
       146
       -
                           Note: The lexeme is partially encoded in the encoder's internal state,

     

       147
       147
       -
                           we don't need to re-queue it. After `Await, the encoder continues. *)

     

       148
       148
       -
                        t.encode_state <- NeedAwait;

     

       149
       149
       -
                        t.buffer_len <- Bytes.length t.buffer - Jsonm.Manual.dst_rem t.encoder)

     

       150
       150
       -
               | Ready when Queue.is_empty t.pending_lexemes && not t.end_signaled ->

     

       151
       151
       -
                   (* All lexemes done, signal end *)

     

       152
       152
       -
                   t.end_signaled <- true;

     

       153
       153
       -
                   (match Jsonm.encode t.encoder `End with

     

       154
       154
       -
                    | `Ok ->

     

       155
       155
       -
                        t.encode_state <- Finished;

     

       156
       156
       -
                        t.buffer_len <- Bytes.length t.buffer - Jsonm.Manual.dst_rem t.encoder

     

       157
       157
       -
                    | `Partial ->

     

       158
       158
       -
                        t.encode_state <- NeedAwait;

     

       159
       159
       -
                        t.buffer_len <- Bytes.length t.buffer - Jsonm.Manual.dst_rem t.encoder)

     

       160
       160
       -
               | Ready when t.end_signaled ->

     

       161
       161
       -
                   (* Continue trying to finish *)

     

       162
       162
       -
                   (match Jsonm.encode t.encoder `End with

     

       163
       163
       -
                    | `Ok ->

     

       164
       164
       -
                        t.encode_state <- Finished;

     

       165
       165
       -
                        t.buffer_len <- Bytes.length t.buffer - Jsonm.Manual.dst_rem t.encoder

     

       166
       166
       -
                    | `Partial ->

     

       167
       167
       -
                        t.encode_state <- NeedAwait;

     

       168
       168
       -
                        t.buffer_len <- Bytes.length t.buffer - Jsonm.Manual.dst_rem t.encoder)

     

       169
       169
       -
               | Finished ->

     

       170
       170
       -
                   (* All done *)

     

       171
       171
       -
                   ()

     

       172
       172
       -
               | _ -> ()

     

       173
       173
       -
             in

     

       174
       174
       -
             process_encoding ();

     

       175
       175
       -
       

     

       176
       176
       -
             if t.buffer_len > 0 then

     

       177
       177
       -
               single_read t dst

     

       178
       178
       -
             else if t.encode_state = Finished then

     

       179
       179
       -
               raise End_of_file

     

       180
       180
       -
             else

     

       181
       181
       -
               (* This shouldn't happen - we should always produce some data or be finished *)

     

       182
       182
       -
               raise End_of_file

     

       183
       72
        
           end

     

       184
       73
        
       

     

       185
       74
        
         let read_methods = []

     

       186
       75
        
       end

     

       187
       76
        
       

     

       188
       188
       -
       let json_stream_source_create writer =

     

       189
       189
       -
         let buffer_size = 4096 in

     

       190
       190
       -
         let buffer = Bytes.create buffer_size in

     

       191
       191
       -
         let encoder = Jsonm.encoder ~minify:true (`Manual) in

     

       192
       192
       -
         let pending_lexemes = Queue.create () in

     

       193
       193
       -
       

     

       194
       194
       -
         (* Call the writer to populate the queue *)

     

       195
       195
       -
         let encode_lexeme lexeme = Queue.add lexeme pending_lexemes in

     

       196
       196
       -
         writer encode_lexeme;

     

       197
       197
       -
       

     

       198
       198
       -
         let t = {

     

       199
       199
       -
           Json_stream_source.encoder;

     

       200
       200
       -
           buffer;

     

       201
       201
       -
           buffer_offset = 0;

     

       202
       202
       -
           buffer_len = 0;

     

       203
       203
       -
           pending_lexemes;

     

       204
       204
       -
           encode_state = Ready;

     

       205
       205
       -
           end_signaled = false;

     

       206
       206
       -
           writer;

     

       207
       207
       -
         } in

     

       77
       77
       +
       let json_stream_source_create json_value =

     

       78
       78
       +
         (* Encode the entire JSON value to string with minified format *)

     

       79
       79
       +
         let content = match Jsont_bytesrw.encode_string' ~format:Jsont.Minify Jsont.json json_value with

     

       80
       80
       +
           | Ok s -> s

     

       81
       81
       +
           | Error e ->

     

       82
       82
       +
               let msg = Jsont.Error.to_string e in

     

       83
       83
       +
               failwith (Printf.sprintf "Failed to encode JSON stream: %s" msg)

     

       84
       84
       +
         in

     

       85
       85
       +
         let t = { Json_stream_source.content; offset = 0 } in

     

       208
       86
        
         let ops = Eio.Flow.Pi.source (module Json_stream_source) in

     

       209
       87
        
         Eio.Resource.T (t, ops)

     

       210
       88
        
       

     

       211
       211
       -
       let json_stream writer =

     

       212
       212
       -
         let source = json_stream_source_create writer in

     

       89
       89
       +
       let json_stream json_value =

     

       90
       90
       +
         let source = json_stream_source_create json_value in

     

       213
       91
        
         Stream { source; mime = Mime.json; length = None }

     

       214
       92
        
       

     

       215
       93
        
       let text content =

+14 -31

stack/requests/lib/body.mli

···

       58
       58
        
       

     

       59
       59
        
       (** {1 Convenience Constructors} *)

     

       60
       60
        
       

     

       61
       61
       -
       type json =

     

       62
       62
       -
         [ `Null | `Bool of bool | `Float of float | `String of string

     

       63
       63
       -
         | `A of json list | `O of (string * json) list ]

     

       64
       64
       -
       (** JSON value representation, compatible with Jsonm's json type. *)

     

       65
       65
       -
       

     

       66
       66
       -
       val json : json -> t

     

       67
       67
       -
       (** [json value] creates a JSON body from a json value.

     

       61
       61
       +
       val json : Jsont.json -> t

     

       62
       62
       +
       (** [json value] creates a JSON body from a Jsont.json value.

     

       68
       63
        
           The value is encoded to a JSON string with Content-Type: application/json.

     

       69
       64
        
       

     

       70
       65
        
           Example:

     

       71
       66
        
           {[

     

       72
       72
       -
             let body = Body.json (`O [

     

       73
       73
       -
               ("status", `String "success");

     

       74
       74
       -
               ("count", `Float 42.);

     

       75
       75
       -
               ("items", `A [`String "first"; `String "second"])

     

       76
       76
       -
             ])

     

       67
       67
       +
             let body = Body.json (Jsont.Object ([

     

       68
       68
       +
               ("status", Jsont.String "success");

     

       69
       69
       +
               ("count", Jsont.Number 42.);

     

       70
       70
       +
               ("items", Jsont.Array ([Jsont.String "first"; Jsont.String "second"], Jsont.Meta.none))

     

       71
       71
       +
             ], Jsont.Meta.none))

     

       77
       72
        
           ]}

     

       78
       73
        
       *)

     

       79
       74
        
       

     

       80
       80
       -
       val json_stream : ((Jsonm.lexeme -> unit) -> unit) -> t

     

       81
       81
       -
       (** [json_stream writer] creates a streaming JSON body using jsonm.

     

       82
       82
       -
           The [writer] function is called with a callback that accepts jsonm lexemes

     

       83
       83
       -
           to encode. The body will be streamed as the lexemes are produced.

     

       75
       75
       +
       val json_stream : Jsont.json -> t

     

       76
       76
       +
       (** [json_stream json_value] creates a streaming JSON body from a Jsont.json value.

     

       77
       77
       +
           The JSON value will be encoded to a minified JSON string and streamed.

     

       84
       78
        
       

     

       85
       79
        
           Example:

     

       86
       80
        
           {[

     

       87
       87
       -
             let body = Body.json_stream (fun encode ->

     

       88
       88
       -
               encode `Os;  (* Start object *)

     

       89
       89
       -
               encode (`Name "users");

     

       90
       90
       -
               encode `As;  (* Start array *)

     

       91
       91
       -
               List.iter (fun user ->

     

       92
       92
       -
                 encode `Os;

     

       93
       93
       -
                 encode (`Name "id");

     

       94
       94
       -
                 encode (`Float (float_of_int user.id));

     

       95
       95
       -
                 encode (`Name "name");

     

       96
       96
       -
                 encode (`String user.name);

     

       97
       97
       -
                 encode `Oe  (* End object *)

     

       98
       98
       -
               ) users;

     

       99
       99
       -
               encode `Ae;  (* End array *)

     

       100
       100
       -
               encode `Oe   (* End object *)

     

       101
       101
       -
             )

     

       81
       81
       +
             let large_data = Jsont.Object ([

     

       82
       82
       +
               ("users", Jsont.Array ([...], Jsont.Meta.none))

     

       83
       83
       +
             ], Jsont.Meta.none) in

     

       84
       84
       +
             let body = Body.json_stream large_data

     

       102
       85
        
           ]}

     

       103
       86
        
       *)

     

       104
       87

+98 -30

stack/requests/lib/cache.ml

···

       78
       78
        
             ) parts

     

       79
       79
        
         | None -> None

     

       80
       80
        
       

     

       81
       81
       +
       (* JSON codec for cache metadata *)

     

       82
       82
       +
       module Metadata = struct

     

       83
       83
       +
         type t = {

     

       84
       84
       +
           status_code : int;

     

       85
       85
       +
           headers : (string * string) list;

     

       86
       86
       +
         }

     

       87
       87
       +
       

     

       88
       88
       +
         let make status_code headers = { status_code; headers }

     

       89
       89
       +
         let status_code t = t.status_code

     

       90
       90
       +
         let headers t = t.headers

     

       91
       91
       +
       

     

       92
       92
       +
         let t_jsont =

     

       93
       93
       +
           let header_pair_jsont =

     

       94
       94
       +
             let dec x y = (x, y) in

     

       95
       95
       +
             let enc (x, y) i = if i = 0 then x else y in

     

       96
       96
       +
             Jsont.t2 ~dec ~enc Jsont.string

     

       97
       97
       +
           in

     

       98
       98
       +
           Jsont.Object.map ~kind:"CacheMetadata" make

     

       99
       99
       +
           |> Jsont.Object.mem "status_code" Jsont.int ~enc:status_code

     

       100
       100
       +
           |> Jsont.Object.mem "headers" (Jsont.list header_pair_jsont) ~enc:headers

     

       101
       101
       +
           |> Jsont.Object.finish

     

       102
       102
       +
       end

     

       103
       103
       +
       

     

       81
       104
        
       let serialize_metadata ~status ~headers =

     

       82
       105
        
         let status_code = Cohttp.Code.code_of_status status in

     

       83
       106
        
         let headers_assoc = Cohttp.Header.to_list headers in

     

       84
       84
       -
         let json = `Assoc [

     

       85
       85
       -
           ("status_code", `Int status_code);

     

       86
       86
       -
           ("headers", `Assoc (List.map (fun (k, v) -> (k, `String v)) headers_assoc));

     

       87
       87
       -
         ] in

     

       88
       88
       -
         Yojson.Basic.to_string json

     

       107
       107
       +
         let metadata = Metadata.make status_code headers_assoc in

     

       108
       108
       +
         match Jsont_bytesrw.encode_string' Metadata.t_jsont metadata with

     

       109
       109
       +
         | Ok s -> s

     

       110
       110
       +
         | Error e -> failwith (Fmt.str "Failed to serialize metadata: %s" (Jsont.Error.to_string e))

     

       89
       111
        
       

     

       90
       112
        
       let deserialize_metadata json_str =

     

       91
       113
        
         try

     

       92
       92
       -
           let open Yojson.Basic.Util in

     

       93
       93
       -
           let json = Yojson.Basic.from_string json_str in

     

       94
       94
       -
           let status_code = json |> member "status_code" |> to_int in

     

       95
       95
       -
           let status = Cohttp.Code.status_of_code status_code in

     

       96
       96
       -
           let headers_json = json |> member "headers" |> to_assoc in

     

       97
       97
       -
           let headers = headers_json

     

       98
       98
       -
             |> List.map (fun (k, v) -> (k, to_string v))

     

       99
       99
       -
             |> Cohttp.Header.of_list in

     

       100
       100
       -
           Some (status, headers)

     

       114
       114
       +
           match Jsont_bytesrw.decode_string' Metadata.t_jsont json_str with

     

       115
       115
       +
           | Ok metadata ->

     

       116
       116
       +
               let status = Cohttp.Code.status_of_code (Metadata.status_code metadata) in

     

       117
       117
       +
               let headers = Cohttp.Header.of_list (Metadata.headers metadata) in

     

       118
       118
       +
               Some (status, headers)

     

       119
       119
       +
           | Error _ -> None

     

       101
       120
        
         with _ -> None

     

       102
       121
        
       

     

       103
       122
        
       let get t ~method_ ~url ~headers =

     
···

       396
       415
        
          | None -> ());

     

       397
       416
        
         Hashtbl.clear t.memory_cache

     

       398
       417
        
       

     

       418
       418
       +
       module Stats = struct

     

       419
       419
       +
         type cacheio_stats = {

     

       420
       420
       +
           total_entries : int;

     

       421
       421
       +
           total_bytes : int;

     

       422
       422
       +
           expired_entries : int;

     

       423
       423
       +
           pinned_entries : int;

     

       424
       424
       +
           temporary_entries : int;

     

       425
       425
       +
         }

     

       426
       426
       +
       

     

       427
       427
       +
         type t = {

     

       428
       428
       +
           memory_cache_entries : int;

     

       429
       429
       +
           cache_backend : string;

     

       430
       430
       +
           enabled : bool;

     

       431
       431
       +
           cache_get_requests : bool;

     

       432
       432
       +
           cache_range_requests : bool;

     

       433
       433
       +
           cacheio_stats : cacheio_stats option;

     

       434
       434
       +
         }

     

       435
       435
       +
       

     

       436
       436
       +
         let make_cacheio_stats total_entries total_bytes expired_entries pinned_entries temporary_entries =

     

       437
       437
       +
           { total_entries; total_bytes; expired_entries; pinned_entries; temporary_entries }

     

       438
       438
       +
       

     

       439
       439
       +
         let make memory_cache_entries cache_backend enabled cache_get_requests cache_range_requests cacheio_stats =

     

       440
       440
       +
           { memory_cache_entries; cache_backend; enabled; cache_get_requests; cache_range_requests; cacheio_stats }

     

       441
       441
       +
       

     

       442
       442
       +
         let cacheio_stats_jsont =

     

       443
       443
       +
           Jsont.Object.map ~kind:"CacheioStats" make_cacheio_stats

     

       444
       444
       +
           |> Jsont.Object.mem "total_entries" Jsont.int ~enc:(fun t -> t.total_entries)

     

       445
       445
       +
           |> Jsont.Object.mem "total_bytes" Jsont.int ~enc:(fun t -> t.total_bytes)

     

       446
       446
       +
           |> Jsont.Object.mem "expired_entries" Jsont.int ~enc:(fun t -> t.expired_entries)

     

       447
       447
       +
           |> Jsont.Object.mem "pinned_entries" Jsont.int ~enc:(fun t -> t.pinned_entries)

     

       448
       448
       +
           |> Jsont.Object.mem "temporary_entries" Jsont.int ~enc:(fun t -> t.temporary_entries)

     

       449
       449
       +
           |> Jsont.Object.finish

     

       450
       450
       +
       

     

       451
       451
       +
         let t_jsont =

     

       452
       452
       +
           Jsont.Object.map ~kind:"CacheStats" make

     

       453
       453
       +
           |> Jsont.Object.mem "memory_cache_entries" Jsont.int ~enc:(fun t -> t.memory_cache_entries)

     

       454
       454
       +
           |> Jsont.Object.mem "cache_backend" Jsont.string ~enc:(fun t -> t.cache_backend)

     

       455
       455
       +
           |> Jsont.Object.mem "enabled" Jsont.bool ~enc:(fun t -> t.enabled)

     

       456
       456
       +
           |> Jsont.Object.mem "cache_get_requests" Jsont.bool ~enc:(fun t -> t.cache_get_requests)

     

       457
       457
       +
           |> Jsont.Object.mem "cache_range_requests" Jsont.bool ~enc:(fun t -> t.cache_range_requests)

     

       458
       458
       +
           |> Jsont.Object.opt_mem "cacheio_stats" cacheio_stats_jsont ~enc:(fun t -> t.cacheio_stats)

     

       459
       459
       +
           |> Jsont.Object.finish

     

       460
       460
       +
       

     

       461
       461
       +
         let to_string t =

     

       462
       462
       +
           match Jsont_bytesrw.encode_string' ~format:Jsont.Indent t_jsont t with

     

       463
       463
       +
           | Ok s -> s

     

       464
       464
       +
           | Error e ->

     

       465
       465
       +
               let msg = Jsont.Error.to_string e in

     

       466
       466
       +
               failwith (Printf.sprintf "Failed to encode stats: %s" msg)

     

       467
       467
       +
       end

     

       468
       468
       +
       

     

       399
       469
        
       let stats t =

     

       400
       470
        
         let cacheio_stats =

     

       401
       471
        
           match t.cacheio with

     

       402
       472
        
           | Some cache ->

     

       403
       473
        
               let stats = Cacheio.stats cache in

     

       404
       404
       -
               `Assoc [

     

       405
       405
       -
                 ("total_entries", `Int (Cacheio.Stats.entry_count stats));

     

       406
       406
       -
                 ("total_bytes", `Int (Int64.to_int (Cacheio.Stats.total_size stats)));

     

       407
       407
       -
                 ("expired_entries", `Int (Cacheio.Stats.expired_count stats));

     

       408
       408
       -
                 ("pinned_entries", `Int (Cacheio.Stats.pinned_count stats));

     

       409
       409
       -
                 ("temporary_entries", `Int (Cacheio.Stats.temporary_count stats));

     

       410
       410
       -
               ]

     

       411
       411
       -
           | None -> `Assoc []

     

       474
       474
       +
               Some (Stats.make_cacheio_stats

     

       475
       475
       +
                 (Cacheio.Stats.entry_count stats)

     

       476
       476
       +
                 (Int64.to_int (Cacheio.Stats.total_size stats))

     

       477
       477
       +
                 (Cacheio.Stats.expired_count stats)

     

       478
       478
       +
                 (Cacheio.Stats.pinned_count stats)

     

       479
       479
       +
                 (Cacheio.Stats.temporary_count stats))

     

       480
       480
       +
           | None -> None

     

       412
       481
        
         in

     

       413
       413
       -
         `Assoc [

     

       414
       414
       -
           ("memory_cache_entries", `Int (Hashtbl.length t.memory_cache));

     

       415
       415
       -
           ("cache_backend", `String (if Option.is_some t.cacheio then "cacheio" else "memory"));

     

       416
       416
       -
           ("enabled", `Bool t.enabled);

     

       417
       417
       -
           ("cache_get_requests", `Bool t.cache_get_requests);

     

       418
       418
       -
           ("cache_range_requests", `Bool t.cache_range_requests);

     

       419
       419
       -
           ("cacheio_stats", cacheio_stats);

     

       420
       420
       -
         ]
     

       482
       482
       +
         Stats.make

     

       483
       483
       +
           (Hashtbl.length t.memory_cache)

     

       484
       484
       +
           (if Option.is_some t.cacheio then "cacheio" else "memory")

     

       485
       485
       +
           t.enabled

     

       486
       486
       +
           t.cache_get_requests

     

       487
       487
       +
           t.cache_range_requests

     

       488
       488
       +
           cacheio_stats

+2 -3

stack/requests/lib/dune

···

       8
       8
        
         cohttp

     

       9
       9
        
         cohttp-eio

     

       10
       10
        
         uri

     

       11
       11
       -
         jsonm

     

       12
       12
       -
         yojson

     

       13
       13
       -
         ezjsonm

     

       11
       11
       +
         jsont

     

       12
       12
       +
         jsont.bytesrw

     

       14
       13
        
         base64

     

       15
       14
        
         cacheio

     

       16
       15
        
         cookeio

-1

stack/requests/requests.opam

···

       17
       17
        
         "ca-certs"

     

       18
       18
        
         "mirage-crypto-rng-eio"

     

       19
       19
        
         "uri"

     

       20
       20
       -
         "yojson"

     

       21
       20
        
         "digestif"

     

       22
       21
        
         "base64"

     

       23
       22
        
         "logs"

-18

stack/requests/test/dune

···

       1
       1
       -
       (test

     

       2
       2
       -
        (name test_requests)

     

       3
       3
       -
        (libraries

     

       4
       4
       -
         requests

     

       5
       5
       -
         alcotest

     

       6
       6
       -
         eio

     

       7
       7
       -
         eio_main

     

       8
       8
       -
         cohttp

     

       9
       9
       -
         cohttp-eio

     

       10
       10
       -
         uri

     

       11
       11
       -
         yojson

     

       12
       12
       -
         logs

     

       13
       13
       -
         str)

     

       14
       14
       -
        (deps

     

       15
       15
       -
         (package requests)))(executable

     

       16
       16
       -
        (name test_connection_pool)

     

       17
       17
       -
        (modules test_connection_pool)

     

       18
       18
       -
        (libraries requests eio_main logs logs.fmt conpool))

-52

stack/requests/test/test_connection_pool.ml

···

       1
       1
       -
       (** Test stateless One API - each request opens a fresh connection *)

     

       2
       2
       -
       

     

       3
       3
       -
       open Eio.Std

     

       4
       4
       -
       

     

       5
       5
       -
       let test_one_stateless () =

     

       6
       6
       -
         (* Initialize RNG for TLS *)

     

       7
       7
       -
         Mirage_crypto_rng_unix.use_default ();

     

       8
       8
       -
       

     

       9
       9
       -
         Eio_main.run @@ fun env ->

     

       10
       10
       -
         Switch.run @@ fun sw ->

     

       11
       11
       -
       

     

       12
       12
       -
         (* Configure logging to see One request activity *)

     

       13
       13
       -
         Logs.set_reporter (Logs_fmt.reporter ());

     

       14
       14
       -
         Logs.set_level (Some Logs.Info);

     

       15
       15
       -
         Logs.Src.set_level Requests.One.src (Some Logs.Info);

     

       16
       16
       -
       

     

       17
       17
       -
         traceln "=== Testing One Stateless API ===\n";

     

       18
       18
       -
         traceln "The One API creates fresh connections for each request (no pooling)\n";

     

       19
       19
       -
       

     

       20
       20
       -
         (* Make multiple requests to the same host using stateless One API *)

     

       21
       21
       -
         let start_time = Unix.gettimeofday () in

     

       22
       22
       -
       

     

       23
       23
       -
         for i = 1 to 10 do

     

       24
       24
       -
           traceln "Request %d:" i;

     

       25
       25
       -
           let response = Requests.One.get ~sw

     

       26
       26
       -
             ~clock:env#clock ~net:env#net

     

       27
       27
       -
             "http://example.com"

     

       28
       28
       -
           in

     

       29
       29
       -
       

     

       30
       30
       -
           traceln "  Status: %d" (Requests.Response.status_code response);

     

       31
       31
       -
           traceln "  Content-Length: %s"

     

       32
       32
       -
             (match Requests.Response.content_length response with

     

       33
       33
       -
              | Some len -> Int64.to_string len

     

       34
       34
       -
              | None -> "unknown");

     

       35
       35
       -
       

     

       36
       36
       -
           (* Connection is fresh for each request - no pooling *)

     

       37
       37
       -
           traceln ""

     

       38
       38
       -
         done;

     

       39
       39
       -
       

     

       40
       40
       -
         let elapsed = Unix.gettimeofday () -. start_time in

     

       41
       41
       -
         traceln "All 10 requests completed in %.2f seconds" elapsed;

     

       42
       42
       -
         traceln "Average: %.2f seconds per request" (elapsed /. 10.0);

     

       43
       43
       -
       

     

       44
       44
       -
         traceln "\n=== Test completed successfully ==="

     

       45
       45
       -
       

     

       46
       46
       -
       let () =

     

       47
       47
       -
         try

     

       48
       48
       -
           test_one_stateless ()

     

       49
       49
       -
         with e ->

     

       50
       50
       -
           traceln "Test failed with exception: %s" (Printexc.to_string e);

     

       51
       51
       -
           Printexc.print_backtrace stdout;

     

       52
       52
       -
           exit 1

-899

stack/requests/test/test_requests.ml

···

       1
       1
       -
       open Eio_main

     

       2
       2
       -
       

     

       3
       3
       -
       let port = ref 8088

     

       4
       4
       -
       

     

       5
       5
       -
       let get_free_port () =

     

       6
       6
       -
         let p = !port in

     

       7
       7
       -
         incr port;

     

       8
       8
       -
         p

     

       9
       9
       -
       

     

       10
       10
       -
       let string_contains s sub =

     

       11
       11
       -
         try

     

       12
       12
       -
           let _ = Str.search_forward (Str.regexp_string sub) s 0 in

     

       13
       13
       -
           true

     

       14
       14
       -
         with Not_found -> false

     

       15
       15
       -
       

     

       16
       16
       -
       module Test_server = struct

     

       17
       17
       -
         open Cohttp_eio

     

       18
       18
       -
       

     

       19
       19
       -
         let make_server ~port handler env =

     

       20
       20
       -
           let server_socket =

     

       21
       21
       -
             Eio.Net.listen env#net ~sw:env#sw ~backlog:128 ~reuse_addr:true

     

       22
       22
       -
               (`Tcp (Eio.Net.Ipaddr.V4.loopback, port))

     

       23
       23
       -
           in

     

       24
       24
       -
           let callback _conn req body =

     

       25
       25
       -
             let (resp, body_content) = handler ~request:req ~body in

     

       26
       26
       -
             Server.respond_string () ~status:(Http.Response.status resp)

     

       27
       27
       -
               ~headers:(Http.Response.headers resp)

     

       28
       28
       -
               ~body:body_content

     

       29
       29
       -
           in

     

       30
       30
       -
           let server = Server.make ~callback () in

     

       31
       31
       -
           Server.run server_socket server ~on_error:(fun exn ->

     

       32
       32
       -
             Logs.err (fun m -> m "Server error: %s" (Printexc.to_string exn))

     

       33
       33
       -
           )

     

       34
       34
       -
       

     

       35
       35
       -
         let echo_handler ~request ~body =

     

       36
       36
       -
           let uri = Http.Request.resource request in

     

       37
       37
       -
           let meth = Http.Request.meth request in

     

       38
       38
       -
           let headers = Http.Request.headers request in

     

       39
       39
       -
           let body_str = Eio.Flow.read_all body in

     

       40
       40
       -
       

     

       41
       41
       -
           let response_body =

     

       42
       42
       -
             `Assoc [

     

       43
       43
       -
               "method", `String (Cohttp.Code.string_of_method meth);

     

       44
       44
       -
               "uri", `String uri;

     

       45
       45
       -
               "headers", `Assoc (

     

       46
       46
       -
                 Cohttp.Header.to_lines headers

     

       47
       47
       -
                 |> List.map (fun line ->

     

       48
       48
       -
                   match String.split_on_char ':' line with

     

       49
       49
       -
                   | [k; v] -> (String.trim k, `String (String.trim v))

     

       50
       50
       -
                   | _ -> ("", `String line)

     

       51
       51
       -
                 )

     

       52
       52
       -
               );

     

       53
       53
       -
               "body", `String body_str;

     

       54
       54
       -
             ]

     

       55
       55
       -
             |> Yojson.Basic.to_string

     

       56
       56
       -
           in

     

       57
       57
       -
       

     

       58
       58
       -
           let resp = Http.Response.make ~status:`OK () in

     

       59
       59
       -
           let resp_headers = Cohttp.Header.add_unless_exists

     

       60
       60
       -
             (Http.Response.headers resp) "content-type" "application/json"

     

       61
       61
       -
           in

     

       62
       62
       -
           ({ resp with headers = resp_headers }, response_body)

     

       63
       63
       -
       

     

       64
       64
       -
         let status_handler status_code ~request:_ ~body:_ =

     

       65
       65
       -
           let status = Cohttp.Code.status_of_code status_code in

     

       66
       66
       -
           let resp = Http.Response.make ~status () in

     

       67
       67
       -
           (resp, "")

     

       68
       68
       -
       

     

       69
       69
       -
         let redirect_handler target_path ~request:_ ~body:_ =

     

       70
       70
       -
           let resp = Http.Response.make ~status:`Moved_permanently () in

     

       71
       71
       -
           let headers = Cohttp.Header.add

     

       72
       72
       -
             (Http.Response.headers resp) "location" target_path

     

       73
       73
       -
           in

     

       74
       74
       -
           ({ resp with headers },  "")

     

       75
       75
       -
       

     

       76
       76
       -
         let cookie_handler ~request ~body:_ =

     

       77
       77
       -
           let headers = Http.Request.headers request in

     

       78
       78
       -
           let cookies =

     

       79
       79
       -
             match Cohttp.Header.get headers "cookie" with

     

       80
       80
       -
             | Some cookie_str -> cookie_str

     

       81
       81
       -
             | None -> "no cookies"

     

       82
       82
       -
           in

     

       83
       83
       -
       

     

       84
       84
       -
           let resp = Http.Response.make ~status:`OK () in

     

       85
       85
       -
           let resp_headers =

     

       86
       86
       -
             Http.Response.headers resp

     

       87
       87
       -
             |> (fun h -> Cohttp.Header.add h "set-cookie" "test_cookie=test_value; Path=/")

     

       88
       88
       -
             |> (fun h -> Cohttp.Header.add h "set-cookie" "session=abc123; Path=/; HttpOnly")

     

       89
       89
       -
           in

     

       90
       90
       -
           ({ resp with headers = resp_headers },

     

       91
       91
       -
        cookies)

     

       92
       92
       -
       

     

       93
       93
       -
         let auth_handler ~request ~body:_ =

     

       94
       94
       -
           let headers = Http.Request.headers request in

     

       95
       95
       -
           let auth_result =

     

       96
       96
       -
             match Cohttp.Header.get headers "authorization" with

     

       97
       97
       -
             | Some auth ->

     

       98
       98
       -
                 if String.starts_with ~prefix:"Bearer " auth then

     

       99
       99
       -
                   let token = String.sub auth 7 (String.length auth - 7) in

     

       100
       100
       -
                   if token = "valid_token" then "authorized"

     

       101
       101
       -
                   else "invalid token"

     

       102
       102
       -
                 else if String.starts_with ~prefix:"Basic " auth then

     

       103
       103
       -
                   "basic auth received"

     

       104
       104
       -
                 else "unknown auth"

     

       105
       105
       -
             | None -> "no auth"

     

       106
       106
       -
           in

     

       107
       107
       -
       

     

       108
       108
       -
           let status =

     

       109
       109
       -
             if auth_result = "authorized" || auth_result = "basic auth received"

     

       110
       110
       -
             then `OK

     

       111
       111
       -
             else `Unauthorized

     

       112
       112
       -
           in

     

       113
       113
       -
           let resp = Http.Response.make ~status () in

     

       114
       114
       -
           (resp, auth_result)

     

       115
       115
       -
       

     

       116
       116
       -
         let json_handler ~request:_ ~body =

     

       117
       117
       -
           let body_str = Eio.Flow.read_all body in

     

       118
       118
       -
           let json =

     

       119
       119
       -
             try

     

       120
       120
       -
               let parsed = Yojson.Basic.from_string body_str in

     

       121
       121
       -
               `Assoc [

     

       122
       122
       -
                 "received", parsed;

     

       123
       123
       -
                 "echo", `Bool true;

     

       124
       124
       -
               ]

     

       125
       125
       -
             with _ ->

     

       126
       126
       -
               `Assoc [

     

       127
       127
       -
                 "error", `String "invalid json";

     

       128
       128
       -
                 "received", `String body_str;

     

       129
       129
       -
               ]

     

       130
       130
       -
           in

     

       131
       131
       -
       

     

       132
       132
       -
           let resp = Http.Response.make ~status:`OK () in

     

       133
       133
       -
           let resp_headers = Cohttp.Header.add_unless_exists

     

       134
       134
       -
             (Http.Response.headers resp) "content-type" "application/json"

     

       135
       135
       -
           in

     

       136
       136
       -
           ({ resp with headers = resp_headers },

     

       137
       137
       -
        Yojson.Basic.to_string json)

     

       138
       138
       -
       

     

       139
       139
       -
         let timeout_handler clock delay ~request:_ ~body:_ =

     

       140
       140
       -
           Eio.Time.sleep clock delay;

     

       141
       141
       -
           let resp = Http.Response.make ~status:`OK () in

     

       142
       142
       -
           (resp,"delayed response")

     

       143
       143
       -
       

     

       144
       144
       -
         let chunked_handler _clock chunks ~request:_ ~body:_ =

     

       145
       145
       -
           let resp = Http.Response.make ~status:`OK () in

     

       146
       146
       -
           let body_str = String.concat "" chunks in

     

       147
       147
       -
           (resp,body_str)

     

       148
       148
       -
       

     

       149
       149
       -
         let large_response_handler size ~request:_ ~body:_ =

     

       150
       150
       -
           let data = String.make size 'X' in

     

       151
       151
       -
           let resp = Http.Response.make ~status:`OK () in

     

       152
       152
       -
           (resp,data)

     

       153
       153
       -
       

     

       154
       154
       -
         let multipart_handler ~request ~body =

     

       155
       155
       -
           let headers = Http.Request.headers request in

     

       156
       156
       -
           let content_type = Cohttp.Header.get headers "content-type" in

     

       157
       157
       -
           let body_str = Eio.Flow.read_all body in

     

       158
       158
       -
       

     

       159
       159
       -
           let result =

     

       160
       160
       -
             match content_type with

     

       161
       161
       -
             | Some ct when String.starts_with ~prefix:"multipart/form-data" ct ->

     

       162
       162
       -
                 Printf.sprintf "Multipart received: %d bytes" (String.length body_str)

     

       163
       163
       -
             | _ -> "Not multipart"

     

       164
       164
       -
           in

     

       165
       165
       -
       

     

       166
       166
       -
           let resp = Http.Response.make ~status:`OK () in

     

       167
       167
       -
           (resp,result)

     

       168
       168
       -
       

     

       169
       169
       -
         let router clock ~request ~body =

     

       170
       170
       -
           let uri = Http.Request.resource request in

     

       171
       171
       -
           match uri with

     

       172
       172
       -
           | "/" | "/echo" -> echo_handler ~request ~body

     

       173
       173
       -
           | "/status/200" -> status_handler 200 ~request ~body

     

       174
       174
       -
           | "/status/404" -> status_handler 404 ~request ~body

     

       175
       175
       -
           | "/status/500" -> status_handler 500 ~request ~body

     

       176
       176
       -
           | "/redirect" -> redirect_handler "/redirected" ~request ~body

     

       177
       177
       -
           | "/redirected" ->

     

       178
       178
       -
               let resp = Http.Response.make ~status:`OK () in

     

       179
       179
       -
               (resp,"redirect successful")

     

       180
       180
       -
           | "/cookies" -> cookie_handler ~request ~body

     

       181
       181
       -
           | "/auth" -> auth_handler ~request ~body

     

       182
       182
       -
           | "/json" -> json_handler ~request ~body

     

       183
       183
       -
           | "/timeout" -> timeout_handler clock 2.0 ~request ~body

     

       184
       184
       -
           | "/chunked" ->

     

       185
       185
       -
               chunked_handler clock ["chunk1"; "chunk2"; "chunk3"] ~request ~body

     

       186
       186
       -
           | "/large" -> large_response_handler 10000 ~request ~body

     

       187
       187
       -
           | "/multipart" -> multipart_handler ~request ~body

     

       188
       188
       -
           | _ -> status_handler 404 ~request ~body

     

       189
       189
       -
       

     

       190
       190
       -
         let start_server ~port env =

     

       191
       191
       -
           Eio.Fiber.fork ~sw:env#sw (fun () ->

     

       192
       192
       -
             make_server ~port (router env#clock) env

     

       193
       193
       -
           );

     

       194
       194
       -
           Eio.Time.sleep env#clock 0.1

     

       195
       195
       -
       end

     

       196
       196
       -
       

     

       197
       197
       -
       let test_get_request () =

     

       198
       198
       -
         run @@ fun env ->

     

       199
       199
       -
         Eio.Switch.run @@ fun sw ->

     

       200
       200
       -
         let port = get_free_port () in

     

       201
       201
       -
         let base_url = Printf.sprintf "http://127.0.0.1:%d" port in

     

       202
       202
       -
       

     

       203
       203
       -
         let test_env = object

     

       204
       204
       -
           method clock = env#clock

     

       205
       205
       -
           method net = env#net

     

       206
       206
       -
           method sw = sw

     

       207
       207
       -
         end in

     

       208
       208
       -
         Test_server.start_server ~port test_env;

     

       209
       209
       -
       

     

       210
       210
       -
         let req = Requests.create ~sw env in

     

       211
       211
       -
         let response = Requests.get req (base_url ^ "/echo") in

     

       212
       212
       -
       

     

       213
       213
       -
         Alcotest.(check int) "GET status" 200 (Requests.Response.status_code response);

     

       214
       214
       -
       

     

       215
       215
       -
         let body_str = Requests.Response.body response |> Eio.Flow.read_all in

     

       216
       216
       -
         let json = Yojson.Basic.from_string body_str in

     

       217
       217
       -
         let method_str =

     

       218
       218
       -
           json |> Yojson.Basic.Util.member "method" |> Yojson.Basic.Util.to_string

     

       219
       219
       -
         in

     

       220
       220
       -
       

     

       221
       221
       -
         Alcotest.(check string) "GET method" "GET" method_str

     

       222
       222
       -
       

     

       223
       223
       -
       let test_post_request () =

     

       224
       224
       -
         run @@ fun env ->

     

       225
       225
       -
         Eio.Switch.run @@ fun sw ->

     

       226
       226
       -
         let port = get_free_port () in

     

       227
       227
       -
         let base_url = Printf.sprintf "http://127.0.0.1:%d" port in

     

       228
       228
       -
       

     

       229
       229
       -
         let test_env = object

     

       230
       230
       -
           method clock = env#clock

     

       231
       231
       -
           method net = env#net

     

       232
       232
       -
           method sw = sw

     

       233
       233
       -
         end in

     

       234
       234
       -
         Test_server.start_server ~port test_env;

     

       235
       235
       -
       

     

       236
       236
       -
         let req = Requests.create ~sw env in

     

       237
       237
       -
         let body = Requests.Body.text "test post data" in

     

       238
       238
       -
         let response = Requests.post req ~body (base_url ^ "/echo") in

     

       239
       239
       -
       

     

       240
       240
       -
         Alcotest.(check int) "POST status" 200 (Requests.Response.status_code response);

     

       241
       241
       -
       

     

       242
       242
       -
         let body_str = Requests.Response.body response |> Eio.Flow.read_all in

     

       243
       243
       -
         let json = Yojson.Basic.from_string body_str in

     

       244
       244
       -
         let received_body =

     

       245
       245
       -
           json |> Yojson.Basic.Util.member "body" |> Yojson.Basic.Util.to_string

     

       246
       246
       -
         in

     

       247
       247
       -
       

     

       248
       248
       -
         Alcotest.(check string) "POST body" "test post data" received_body

     

       249
       249
       -
       

     

       250
       250
       -
       let test_put_request () =

     

       251
       251
       -
         run @@ fun env ->

     

       252
       252
       -
         Eio.Switch.run @@ fun sw ->

     

       253
       253
       -
         let port = get_free_port () in

     

       254
       254
       -
         let base_url = Printf.sprintf "http://127.0.0.1:%d" port in

     

       255
       255
       -
       

     

       256
       256
       -
         let test_env = object

     

       257
       257
       -
           method clock = env#clock

     

       258
       258
       -
           method net = env#net

     

       259
       259
       -
           method sw = sw

     

       260
       260
       -
         end in

     

       261
       261
       -
         Test_server.start_server ~port test_env;

     

       262
       262
       -
       

     

       263
       263
       -
         let req = Requests.create ~sw env in

     

       264
       264
       -
         let body = Requests.Body.text "put data" in

     

       265
       265
       -
         let response = Requests.put req ~body (base_url ^ "/echo") in

     

       266
       266
       -
       

     

       267
       267
       -
         Alcotest.(check int) "PUT status" 200 (Requests.Response.status_code response);

     

       268
       268
       -
       

     

       269
       269
       -
         let body_str = Requests.Response.body response |> Eio.Flow.read_all in

     

       270
       270
       -
         let json = Yojson.Basic.from_string body_str in

     

       271
       271
       -
         let method_str =

     

       272
       272
       -
           json |> Yojson.Basic.Util.member "method" |> Yojson.Basic.Util.to_string

     

       273
       273
       -
         in

     

       274
       274
       -
       

     

       275
       275
       -
         Alcotest.(check string) "PUT method" "PUT" method_str

     

       276
       276
       -
       

     

       277
       277
       -
       let test_delete_request () =

     

       278
       278
       -
         run @@ fun env ->

     

       279
       279
       -
         Eio.Switch.run @@ fun sw ->

     

       280
       280
       -
         let port = get_free_port () in

     

       281
       281
       -
         let base_url = Printf.sprintf "http://127.0.0.1:%d" port in

     

       282
       282
       -
       

     

       283
       283
       -
         let test_env = object

     

       284
       284
       -
           method clock = env#clock

     

       285
       285
       -
           method net = env#net

     

       286
       286
       -
           method sw = sw

     

       287
       287
       -
         end in

     

       288
       288
       -
         Test_server.start_server ~port test_env;

     

       289
       289
       -
       

     

       290
       290
       -
         let req = Requests.create ~sw env in

     

       291
       291
       -
         let response = Requests.delete req (base_url ^ "/echo") in

     

       292
       292
       -
       

     

       293
       293
       -
         Alcotest.(check int) "DELETE status" 200 (Requests.Response.status_code response);

     

       294
       294
       -
       

     

       295
       295
       -
         let body_str = Requests.Response.body response |> Eio.Flow.read_all in

     

       296
       296
       -
         let json = Yojson.Basic.from_string body_str in

     

       297
       297
       -
         let method_str =

     

       298
       298
       -
           json |> Yojson.Basic.Util.member "method" |> Yojson.Basic.Util.to_string

     

       299
       299
       -
         in

     

       300
       300
       -
       

     

       301
       301
       -
         Alcotest.(check string) "DELETE method" "DELETE" method_str

     

       302
       302
       -
       

     

       303
       303
       -
       let test_patch_request () =

     

       304
       304
       -
         run @@ fun env ->

     

       305
       305
       -
         Eio.Switch.run @@ fun sw ->

     

       306
       306
       -
         let port = get_free_port () in

     

       307
       307
       -
         let base_url = Printf.sprintf "http://127.0.0.1:%d" port in

     

       308
       308
       -
       

     

       309
       309
       -
         let test_env = object

     

       310
       310
       -
           method clock = env#clock

     

       311
       311
       -
           method net = env#net

     

       312
       312
       -
           method sw = sw

     

       313
       313
       -
         end in

     

       314
       314
       -
         Test_server.start_server ~port test_env;

     

       315
       315
       -
       

     

       316
       316
       -
         let req = Requests.create ~sw env in

     

       317
       317
       -
         let body = Requests.Body.of_string Requests.Mime.json {|{"patch": "data"}|} in

     

       318
       318
       -
         let response = Requests.patch req ~body (base_url ^ "/echo") in

     

       319
       319
       -
       

     

       320
       320
       -
         Alcotest.(check int) "PATCH status" 200 (Requests.Response.status_code response);

     

       321
       321
       -
       

     

       322
       322
       -
         let body_str = Requests.Response.body response |> Eio.Flow.read_all in

     

       323
       323
       -
         let json = Yojson.Basic.from_string body_str in

     

       324
       324
       -
         let method_str =

     

       325
       325
       -
           json |> Yojson.Basic.Util.member "method" |> Yojson.Basic.Util.to_string

     

       326
       326
       -
         in

     

       327
       327
       -
       

     

       328
       328
       -
         Alcotest.(check string) "PATCH method" "PATCH" method_str

     

       329
       329
       -
       

     

       330
       330
       -
       let test_head_request () =

     

       331
       331
       -
         run @@ fun env ->

     

       332
       332
       -
         Eio.Switch.run @@ fun sw ->

     

       333
       333
       -
         let port = get_free_port () in

     

       334
       334
       -
         let base_url = Printf.sprintf "http://127.0.0.1:%d" port in

     

       335
       335
       -
       

     

       336
       336
       -
         let test_env = object

     

       337
       337
       -
           method clock = env#clock

     

       338
       338
       -
           method net = env#net

     

       339
       339
       -
           method sw = sw

     

       340
       340
       -
         end in

     

       341
       341
       -
         Test_server.start_server ~port test_env;

     

       342
       342
       -
       

     

       343
       343
       -
         let req = Requests.create ~sw env in

     

       344
       344
       -
         let response = Requests.head req (base_url ^ "/echo") in

     

       345
       345
       -
       

     

       346
       346
       -
         Alcotest.(check int) "HEAD status" 200 (Requests.Response.status_code response)

     

       347
       347
       -
       

     

       348
       348
       -
       let test_options_request () =

     

       349
       349
       -
         run @@ fun env ->

     

       350
       350
       -
         Eio.Switch.run @@ fun sw ->

     

       351
       351
       -
         let port = get_free_port () in

     

       352
       352
       -
         let base_url = Printf.sprintf "http://127.0.0.1:%d" port in

     

       353
       353
       -
       

     

       354
       354
       -
         let test_env = object

     

       355
       355
       -
           method clock = env#clock

     

       356
       356
       -
           method net = env#net

     

       357
       357
       -
           method sw = sw

     

       358
       358
       -
         end in

     

       359
       359
       -
         Test_server.start_server ~port test_env;

     

       360
       360
       -
       

     

       361
       361
       -
         let req = Requests.create ~sw env in

     

       362
       362
       -
         let response = Requests.options req (base_url ^ "/echo") in

     

       363
       363
       -
       

     

       364
       364
       -
         Alcotest.(check int) "OPTIONS status" 200 (Requests.Response.status_code response)

     

       365
       365
       -
       

     

       366
       366
       -
       let test_custom_headers () =

     

       367
       367
       -
         run @@ fun env ->

     

       368
       368
       -
         Eio.Switch.run @@ fun sw ->

     

       369
       369
       -
         let port = get_free_port () in

     

       370
       370
       -
         let base_url = Printf.sprintf "http://127.0.0.1:%d" port in

     

       371
       371
       -
       

     

       372
       372
       -
         let test_env = object

     

       373
       373
       -
           method clock = env#clock

     

       374
       374
       -
           method net = env#net

     

       375
       375
       -
           method sw = sw

     

       376
       376
       -
         end in

     

       377
       377
       -
         Test_server.start_server ~port test_env;

     

       378
       378
       -
       

     

       379
       379
       -
         let req = Requests.create ~sw env in

     

       380
       380
       -
         let headers =

     

       381
       381
       -
           Requests.Headers.empty

     

       382
       382
       -
           |> Requests.Headers.set "X-Custom-Header" "custom-value"

     

       383
       383
       -
           |> Requests.Headers.set "User-Agent" "test-agent"

     

       384
       384
       -
         in

     

       385
       385
       -
         let response = Requests.get req ~headers (base_url ^ "/echo") in

     

       386
       386
       -
       

     

       387
       387
       -
         Alcotest.(check int) "Headers status" 200 (Requests.Response.status_code response);

     

       388
       388
       -
       

     

       389
       389
       -
         let body_str = Requests.Response.body response |> Eio.Flow.read_all in

     

       390
       390
       -
         let json = Yojson.Basic.from_string body_str in

     

       391
       391
       -
         let headers_obj = json |> Yojson.Basic.Util.member "headers" in

     

       392
       392
       -
       

     

       393
       393
       -
         let custom_header =

     

       394
       394
       -
           headers_obj

     

       395
       395
       -
           |> Yojson.Basic.Util.member "x-custom-header"

     

       396
       396
       -
           |> Yojson.Basic.Util.to_string_option

     

       397
       397
       -
           |> Option.value ~default:""

     

       398
       398
       -
         in

     

       399
       399
       -
       

     

       400
       400
       -
         Alcotest.(check string) "Custom header" "custom-value" custom_header

     

       401
       401
       -
       

     

       402
       402
       -
       let test_query_params () =

     

       403
       403
       -
         run @@ fun env ->

     

       404
       404
       -
         Eio.Switch.run @@ fun sw ->

     

       405
       405
       -
         let port = get_free_port () in

     

       406
       406
       -
         let base_url = Printf.sprintf "http://127.0.0.1:%d" port in

     

       407
       407
       -
       

     

       408
       408
       -
         let test_env = object

     

       409
       409
       -
           method clock = env#clock

     

       410
       410
       -
           method net = env#net

     

       411
       411
       -
           method sw = sw

     

       412
       412
       -
         end in

     

       413
       413
       -
         Test_server.start_server ~port test_env;

     

       414
       414
       -
       

     

       415
       415
       -
         let req = Requests.create ~sw env in

     

       416
       416
       -
         let params = [("key1", "value1"); ("key2", "value2")] in

     

       417
       417
       -
         let response = Requests.get req ~params (base_url ^ "/echo") in

     

       418
       418
       -
       

     

       419
       419
       -
         Alcotest.(check int) "Query params status" 200 (Requests.Response.status_code response);

     

       420
       420
       -
       

     

       421
       421
       -
         let body_str = Requests.Response.body response |> Eio.Flow.read_all in

     

       422
       422
       -
         let json = Yojson.Basic.from_string body_str in

     

       423
       423
       -
         let uri = json |> Yojson.Basic.Util.member "uri" |> Yojson.Basic.Util.to_string in

     

       424
       424
       -
       

     

       425
       425
       -
         Alcotest.(check bool) "Query params present" true

     

       426
       426
       -
           (string_contains uri "key1=value1" && string_contains uri "key2=value2")

     

       427
       427
       -
       

     

       428
       428
       -
       let test_json_body () =

     

       429
       429
       -
         run @@ fun env ->

     

       430
       430
       -
         Eio.Switch.run @@ fun sw ->

     

       431
       431
       -
         let port = get_free_port () in

     

       432
       432
       -
         let base_url = Printf.sprintf "http://127.0.0.1:%d" port in

     

       433
       433
       -
       

     

       434
       434
       -
         let test_env = object

     

       435
       435
       -
           method clock = env#clock

     

       436
       436
       -
           method net = env#net

     

       437
       437
       -
           method sw = sw

     

       438
       438
       -
         end in

     

       439
       439
       -
         Test_server.start_server ~port test_env;

     

       440
       440
       -
       

     

       441
       441
       -
         let req = Requests.create ~sw env in

     

       442
       442
       -
         let json_data = {|{"name": "test", "value": 42}|} in

     

       443
       443
       -
         let body = Requests.Body.of_string Requests.Mime.json json_data in

     

       444
       444
       -
         let response = Requests.post req ~body (base_url ^ "/json") in

     

       445
       445
       -
       

     

       446
       446
       -
         Alcotest.(check int) "JSON body status" 200 (Requests.Response.status_code response);

     

       447
       447
       -
       

     

       448
       448
       -
         let body_str = Requests.Response.body response |> Eio.Flow.read_all in

     

       449
       449
       -
         let json = Yojson.Basic.from_string body_str in

     

       450
       450
       -
         let received = json |> Yojson.Basic.Util.member "received" in

     

       451
       451
       -
         let name = received |> Yojson.Basic.Util.member "name" |> Yojson.Basic.Util.to_string in

     

       452
       452
       -
       

     

       453
       453
       -
         Alcotest.(check string) "JSON field" "test" name

     

       454
       454
       -
       

     

       455
       455
       -
       let test_form_data () =

     

       456
       456
       -
         run @@ fun env ->

     

       457
       457
       -
         Eio.Switch.run @@ fun sw ->

     

       458
       458
       -
         let port = get_free_port () in

     

       459
       459
       -
         let base_url = Printf.sprintf "http://127.0.0.1:%d" port in

     

       460
       460
       -
       

     

       461
       461
       -
         let test_env = object

     

       462
       462
       -
           method clock = env#clock

     

       463
       463
       -
           method net = env#net

     

       464
       464
       -
           method sw = sw

     

       465
       465
       -
         end in

     

       466
       466
       -
         Test_server.start_server ~port test_env;

     

       467
       467
       -
       

     

       468
       468
       -
         let req = Requests.create ~sw env in

     

       469
       469
       -
         let form_data = [("field1", "value1"); ("field2", "value2")] in

     

       470
       470
       -
         let body = Requests.Body.form form_data in

     

       471
       471
       -
         let response = Requests.post req ~body (base_url ^ "/echo") in

     

       472
       472
       -
       

     

       473
       473
       -
         Alcotest.(check int) "Form data status" 200 (Requests.Response.status_code response);

     

       474
       474
       -
       

     

       475
       475
       -
         let body_str = Requests.Response.body response |> Eio.Flow.read_all in

     

       476
       476
       -
         let json = Yojson.Basic.from_string body_str in

     

       477
       477
       -
         let received_body =

     

       478
       478
       -
           json |> Yojson.Basic.Util.member "body" |> Yojson.Basic.Util.to_string

     

       479
       479
       -
         in

     

       480
       480
       -
       

     

       481
       481
       -
         Alcotest.(check bool) "Form data encoded" true

     

       482
       482
       -
           (string_contains received_body "field1=value1" &&

     

       483
       483
       -
            string_contains received_body "field2=value2")

     

       484
       484
       -
       

     

       485
       485
       -
       let test_status_codes () =

     

       486
       486
       -
         run @@ fun env ->

     

       487
       487
       -
         Eio.Switch.run @@ fun sw ->

     

       488
       488
       -
         let port = get_free_port () in

     

       489
       489
       -
         let base_url = Printf.sprintf "http://127.0.0.1:%d" port in

     

       490
       490
       -
       

     

       491
       491
       -
         let test_env = object

     

       492
       492
       -
           method clock = env#clock

     

       493
       493
       -
           method net = env#net

     

       494
       494
       -
           method sw = sw

     

       495
       495
       -
         end in

     

       496
       496
       -
         Test_server.start_server ~port test_env;

     

       497
       497
       -
       

     

       498
       498
       -
         let req = Requests.create ~sw env in

     

       499
       499
       -
       

     

       500
       500
       -
         let resp_200 = Requests.get req (base_url ^ "/status/200") in

     

       501
       501
       -
         Alcotest.(check int) "Status 200" 200 (Requests.Response.status_code resp_200);

     

       502
       502
       -
       

     

       503
       503
       -
         let resp_404 = Requests.get req (base_url ^ "/status/404") in

     

       504
       504
       -
         Alcotest.(check int) "Status 404" 404 (Requests.Response.status_code resp_404);

     

       505
       505
       -
       

     

       506
       506
       -
         let resp_500 = Requests.get req (base_url ^ "/status/500") in

     

       507
       507
       -
         Alcotest.(check int) "Status 500" 500 (Requests.Response.status_code resp_500)

     

       508
       508
       -
       

     

       509
       509
       -
       let test_redirects () =

     

       510
       510
       -
         run @@ fun env ->

     

       511
       511
       -
         Eio.Switch.run @@ fun sw ->

     

       512
       512
       -
         let port = get_free_port () in

     

       513
       513
       -
         let base_url = Printf.sprintf "http://127.0.0.1:%d" port in

     

       514
       514
       -
       

     

       515
       515
       -
         let test_env = object

     

       516
       516
       -
           method clock = env#clock

     

       517
       517
       -
           method net = env#net

     

       518
       518
       -
           method sw = sw

     

       519
       519
       -
         end in

     

       520
       520
       -
         Test_server.start_server ~port test_env;

     

       521
       521
       -
       

     

       522
       522
       -
         let req = Requests.create ~sw ~follow_redirects:true env in

     

       523
       523
       -
         let response = Requests.get req (base_url ^ "/redirect") in

     

       524
       524
       -
       

     

       525
       525
       -
         Alcotest.(check int) "Redirect followed" 200 (Requests.Response.status_code response);

     

       526
       526
       -
       

     

       527
       527
       -
         let body_str = Requests.Response.body response |> Eio.Flow.read_all in

     

       528
       528
       -
         Alcotest.(check string) "Redirect result" "redirect successful" body_str

     

       529
       529
       -
       

     

       530
       530
       -
       let test_no_redirect () =

     

       531
       531
       -
         run @@ fun env ->

     

       532
       532
       -
         Eio.Switch.run @@ fun sw ->

     

       533
       533
       -
         let port = get_free_port () in

     

       534
       534
       -
         let base_url = Printf.sprintf "http://127.0.0.1:%d" port in

     

       535
       535
       -
       

     

       536
       536
       -
         let test_env = object

     

       537
       537
       -
           method clock = env#clock

     

       538
       538
       -
           method net = env#net

     

       539
       539
       -
           method sw = sw

     

       540
       540
       -
         end in

     

       541
       541
       -
         Test_server.start_server ~port test_env;

     

       542
       542
       -
       

     

       543
       543
       -
         let req = Requests.create ~sw env in

     

       544
       544
       -
         let response = Requests.request req ~follow_redirects:false ~method_:`GET (base_url ^ "/redirect") in

     

       545
       545
       -
       

     

       546
       546
       -
         Alcotest.(check int) "Redirect not followed" 301

     

       547
       547
       -
           (Requests.Response.status_code response)

     

       548
       548
       -
       

     

       549
       549
       -
       let test_cookies () =

     

       550
       550
       -
         run @@ fun env ->

     

       551
       551
       -
         Eio.Switch.run @@ fun sw ->

     

       552
       552
       -
         let port = get_free_port () in

     

       553
       553
       -
         let base_url = Printf.sprintf "http://127.0.0.1:%d" port in

     

       554
       554
       -
       

     

       555
       555
       -
         let test_env = object

     

       556
       556
       -
           method clock = env#clock

     

       557
       557
       -
           method net = env#net

     

       558
       558
       -
           method sw = sw

     

       559
       559
       -
         end in

     

       560
       560
       -
         Test_server.start_server ~port test_env;

     

       561
       561
       -
       

     

       562
       562
       -
         let req = Requests.create ~sw env in

     

       563
       563
       -
       

     

       564
       564
       -
         let _first_response = Requests.get req (base_url ^ "/cookies") in

     

       565
       565
       -
       

     

       566
       566
       -
         let second_response = Requests.get req (base_url ^ "/cookies") in

     

       567
       567
       -
         let body_str = Requests.Response.body second_response |> Eio.Flow.read_all in

     

       568
       568
       -
       

     

       569
       569
       -
         Alcotest.(check bool) "Cookies sent back" true

     

       570
       570
       -
           (string_contains body_str "test_cookie=test_value")

     

       571
       571
       -
       

     

       572
       572
       -
       let test_bearer_auth () =

     

       573
       573
       -
         run @@ fun env ->

     

       574
       574
       -
         Eio.Switch.run @@ fun sw ->

     

       575
       575
       -
         let port = get_free_port () in

     

       576
       576
       -
         let base_url = Printf.sprintf "http://127.0.0.1:%d" port in

     

       577
       577
       -
       

     

       578
       578
       -
         let test_env = object

     

       579
       579
       -
           method clock = env#clock

     

       580
       580
       -
           method net = env#net

     

       581
       581
       -
           method sw = sw

     

       582
       582
       -
         end in

     

       583
       583
       -
         Test_server.start_server ~port test_env;

     

       584
       584
       -
       

     

       585
       585
       -
         let req = Requests.create ~sw env in

     

       586
       586
       -
         let auth = Requests.Auth.bearer ~token:"valid_token" in

     

       587
       587
       -
         let response = Requests.get req ~auth (base_url ^ "/auth") in

     

       588
       588
       -
       

     

       589
       589
       -
         Alcotest.(check int) "Bearer auth status" 200 (Requests.Response.status_code response);

     

       590
       590
       -
       

     

       591
       591
       -
         let body_str = Requests.Response.body response |> Eio.Flow.read_all in

     

       592
       592
       -
         Alcotest.(check string) "Bearer auth result" "authorized" body_str

     

       593
       593
       -
       

     

       594
       594
       -
       let test_basic_auth () =

     

       595
       595
       -
         run @@ fun env ->

     

       596
       596
       -
         Eio.Switch.run @@ fun sw ->

     

       597
       597
       -
         let port = get_free_port () in

     

       598
       598
       -
         let base_url = Printf.sprintf "http://127.0.0.1:%d" port in

     

       599
       599
       -
       

     

       600
       600
       -
         let test_env = object

     

       601
       601
       -
           method clock = env#clock

     

       602
       602
       -
           method net = env#net

     

       603
       603
       -
           method sw = sw

     

       604
       604
       -
         end in

     

       605
       605
       -
         Test_server.start_server ~port test_env;

     

       606
       606
       -
       

     

       607
       607
       -
         let req = Requests.create ~sw env in

     

       608
       608
       -
         let auth = Requests.Auth.basic ~username:"user" ~password:"pass" in

     

       609
       609
       -
         let response = Requests.get req ~auth (base_url ^ "/auth") in

     

       610
       610
       -
       

     

       611
       611
       -
         Alcotest.(check int) "Basic auth status" 200 (Requests.Response.status_code response);

     

       612
       612
       -
       

     

       613
       613
       -
         let body_str = Requests.Response.body response |> Eio.Flow.read_all in

     

       614
       614
       -
         Alcotest.(check string) "Basic auth result" "basic auth received" body_str

     

       615
       615
       -
       

     

       616
       616
       -
       let test_timeout () =

     

       617
       617
       -
         run @@ fun env ->

     

       618
       618
       -
         Eio.Switch.run @@ fun sw ->

     

       619
       619
       -
         let port = get_free_port () in

     

       620
       620
       -
         let base_url = Printf.sprintf "http://127.0.0.1:%d" port in

     

       621
       621
       -
       

     

       622
       622
       -
         let test_env = object

     

       623
       623
       -
           method clock = env#clock

     

       624
       624
       -
           method net = env#net

     

       625
       625
       -
           method sw = sw

     

       626
       626
       -
         end in

     

       627
       627
       -
         Test_server.start_server ~port test_env;

     

       628
       628
       -
       

     

       629
       629
       -
         let req = Requests.create ~sw env in

     

       630
       630
       -
         let timeout = Requests.Timeout.create ~total:0.5 () in

     

       631
       631
       -
       

     

       632
       632
       -
         let exception_raised =

     

       633
       633
       -
           try

     

       634
       634
       -
             let _ = Requests.get req ~timeout (base_url ^ "/timeout") in

     

       635
       635
       -
             false

     

       636
       636
       -
           with _ -> true

     

       637
       637
       -
         in

     

       638
       638
       -
       

     

       639
       639
       -
         Alcotest.(check bool) "Timeout triggered" true exception_raised

     

       640
       640
       -
       

     

       641
       641
       -
       let test_concurrent_requests () =

     

       642
       642
       -
         run @@ fun env ->

     

       643
       643
       -
         Eio.Switch.run @@ fun sw ->

     

       644
       644
       -
         let port = get_free_port () in

     

       645
       645
       -
         let base_url = Printf.sprintf "http://127.0.0.1:%d" port in

     

       646
       646
       -
       

     

       647
       647
       -
         let test_env = object

     

       648
       648
       -
           method clock = env#clock

     

       649
       649
       -
           method net = env#net

     

       650
       650
       -
           method sw = sw

     

       651
       651
       -
         end in

     

       652
       652
       -
         Test_server.start_server ~port test_env;

     

       653
       653
       -
       

     

       654
       654
       -
         let req = Requests.create ~sw env in

     

       655
       655
       -
       

     

       656
       656
       -
         let r1 = ref None in

     

       657
       657
       -
         let r2 = ref None in

     

       658
       658
       -
         let r3 = ref None in

     

       659
       659
       -
       

     

       660
       660
       -
         Eio.Fiber.all [

     

       661
       661
       -
           (fun () -> r1 := Some (Requests.get req (base_url ^ "/status/200")));

     

       662
       662
       -
           (fun () -> r2 := Some (Requests.get req (base_url ^ "/status/404")));

     

       663
       663
       -
           (fun () -> r3 := Some (Requests.get req (base_url ^ "/status/500")));

     

       664
       664
       -
         ];

     

       665
       665
       -
       

     

       666
       666
       -
         let r1 = Option.get !r1 in

     

       667
       667
       -
         let r2 = Option.get !r2 in

     

       668
       668
       -
         let r3 = Option.get !r3 in

     

       669
       669
       -
       

     

       670
       670
       -
         Alcotest.(check int) "Concurrent 1" 200 (Requests.Response.status_code r1);

     

       671
       671
       -
         Alcotest.(check int) "Concurrent 2" 404 (Requests.Response.status_code r2);

     

       672
       672
       -
         Alcotest.(check int) "Concurrent 3" 500 (Requests.Response.status_code r3)

     

       673
       673
       -
       

     

       674
       674
       -
       let test_large_response () =

     

       675
       675
       -
         run @@ fun env ->

     

       676
       676
       -
         Eio.Switch.run @@ fun sw ->

     

       677
       677
       -
         let port = get_free_port () in

     

       678
       678
       -
         let base_url = Printf.sprintf "http://127.0.0.1:%d" port in

     

       679
       679
       -
       

     

       680
       680
       -
         let test_env = object

     

       681
       681
       -
           method clock = env#clock

     

       682
       682
       -
           method net = env#net

     

       683
       683
       -
           method sw = sw

     

       684
       684
       -
         end in

     

       685
       685
       -
         Test_server.start_server ~port test_env;

     

       686
       686
       -
       

     

       687
       687
       -
         let req = Requests.create ~sw env in

     

       688
       688
       -
         let response = Requests.get req (base_url ^ "/large") in

     

       689
       689
       -
       

     

       690
       690
       -
         Alcotest.(check int) "Large response status" 200 (Requests.Response.status_code response);

     

       691
       691
       -
       

     

       692
       692
       -
         let body_str = Requests.Response.body response |> Eio.Flow.read_all in

     

       693
       693
       -
         Alcotest.(check int) "Large response size" 10000 (String.length body_str)

     

       694
       694
       -
       

     

       695
       695
       -
       let test_one_module () =

     

       696
       696
       -
         run @@ fun env ->

     

       697
       697
       -
         Eio.Switch.run @@ fun sw ->

     

       698
       698
       -
         let port = get_free_port () in

     

       699
       699
       -
         let base_url = Printf.sprintf "http://127.0.0.1:%d" port in

     

       700
       700
       -
       

     

       701
       701
       -
         let test_env = object

     

       702
       702
       -
           method clock = env#clock

     

       703
       703
       -
           method net = env#net

     

       704
       704
       -
           method sw = sw

     

       705
       705
       -
         end in

     

       706
       706
       -
         Test_server.start_server ~port test_env;

     

       707
       707
       -
       

     

       708
       708
       -
         let response = Requests.One.get ~sw

     

       709
       709
       -
           ~clock:env#clock ~net:env#net

     

       710
       710
       -
           (base_url ^ "/echo")

     

       711
       711
       -
         in

     

       712
       712
       -
       

     

       713
       713
       -
         Alcotest.(check int) "One module status" 200 (Requests.Response.status_code response)

     

       714
       714
       -
       

     

       715
       715
       -
       let test_multipart () =

     

       716
       716
       -
         run @@ fun env ->

     

       717
       717
       -
         Eio.Switch.run @@ fun sw ->

     

       718
       718
       -
         let port = get_free_port () in

     

       719
       719
       -
         let base_url = Printf.sprintf "http://127.0.0.1:%d" port in

     

       720
       720
       -
       

     

       721
       721
       -
         let test_env = object

     

       722
       722
       -
           method clock = env#clock

     

       723
       723
       -
           method net = env#net

     

       724
       724
       -
           method sw = sw

     

       725
       725
       -
         end in

     

       726
       726
       -
         Test_server.start_server ~port test_env;

     

       727
       727
       -
       

     

       728
       728
       -
         let req = Requests.create ~sw env in

     

       729
       729
       -
         let parts = [

     

       730
       730
       -
           { Requests.Body.name = "field1";

     

       731
       731
       -
             filename = None;

     

       732
       732
       -
             content_type = Requests.Mime.text;

     

       733
       733
       -
             content = `String "value1" };

     

       734
       734
       -
           { Requests.Body.name = "field2";

     

       735
       735
       -
             filename = Some "test.txt";

     

       736
       736
       -
             content_type = Requests.Mime.text;

     

       737
       737
       -
             content = `String "file content" };

     

       738
       738
       -
         ] in

     

       739
       739
       -
         let body = Requests.Body.multipart parts in

     

       740
       740
       -
         let response = Requests.post req ~body (base_url ^ "/multipart") in

     

       741
       741
       -
       

     

       742
       742
       -
         Alcotest.(check int) "Multipart status" 200 (Requests.Response.status_code response);

     

       743
       743
       -
       

     

       744
       744
       -
         let body_str = Requests.Response.body response |> Eio.Flow.read_all in

     

       745
       745
       -
         Alcotest.(check bool) "Multipart recognized" true

     

       746
       746
       -
           (String.starts_with ~prefix:"Multipart received:" body_str)

     

       747
       747
       -
       

     

       748
       748
       -
       let test_response_headers () =

     

       749
       749
       -
         run @@ fun env ->

     

       750
       750
       -
         Eio.Switch.run @@ fun sw ->

     

       751
       751
       -
         let port = get_free_port () in

     

       752
       752
       -
         let base_url = Printf.sprintf "http://127.0.0.1:%d" port in

     

       753
       753
       -
       

     

       754
       754
       -
         let test_env = object

     

       755
       755
       -
           method clock = env#clock

     

       756
       756
       -
           method net = env#net

     

       757
       757
       -
           method sw = sw

     

       758
       758
       -
         end in

     

       759
       759
       -
         Test_server.start_server ~port test_env;

     

       760
       760
       -
       

     

       761
       761
       -
         let req = Requests.create ~sw env in

     

       762
       762
       -
         let response = Requests.get req (base_url ^ "/json") in

     

       763
       763
       -
       

     

       764
       764
       -
         let content_type =

     

       765
       765
       -
           Requests.Response.headers response

     

       766
       766
       -
           |> Requests.Headers.get "content-type"

     

       767
       767
       -
         in

     

       768
       768
       -
       

     

       769
       769
       -
         Alcotest.(check (option string)) "Response content-type"

     

       770
       770
       -
           (Some "application/json") content_type

     

       771
       771
       -
       

     

       772
       772
       -
       let test_default_headers () =

     

       773
       773
       -
         run @@ fun env ->

     

       774
       774
       -
         Eio.Switch.run @@ fun sw ->

     

       775
       775
       -
         let port = get_free_port () in

     

       776
       776
       -
         let base_url = Printf.sprintf "http://127.0.0.1:%d" port in

     

       777
       777
       -
       

     

       778
       778
       -
         let test_env = object

     

       779
       779
       -
           method clock = env#clock

     

       780
       780
       -
           method net = env#net

     

       781
       781
       -
           method sw = sw

     

       782
       782
       -
         end in

     

       783
       783
       -
         Test_server.start_server ~port test_env;

     

       784
       784
       -
       

     

       785
       785
       -
         let default_headers =

     

       786
       786
       -
           Requests.Headers.empty

     

       787
       787
       -
           |> Requests.Headers.set "X-Default" "default-value"

     

       788
       788
       -
         in

     

       789
       789
       -
         let req = Requests.create ~sw ~default_headers env in

     

       790
       790
       -
         let response = Requests.get req (base_url ^ "/echo") in

     

       791
       791
       -
       

     

       792
       792
       -
         let body_str = Requests.Response.body response |> Eio.Flow.read_all in

     

       793
       793
       -
         let json = Yojson.Basic.from_string body_str in

     

       794
       794
       -
         let headers_obj = json |> Yojson.Basic.Util.member "headers" in

     

       795
       795
       -
       

     

       796
       796
       -
         let default_header =

     

       797
       797
       -
           headers_obj

     

       798
       798
       -
           |> Yojson.Basic.Util.member "x-default"

     

       799
       799
       -
           |> Yojson.Basic.Util.to_string_option

     

       800
       800
       -
           |> Option.value ~default:""

     

       801
       801
       -
         in

     

       802
       802
       -
       

     

       803
       803
       -
         Alcotest.(check string) "Default header present" "default-value" default_header

     

       804
       804
       -
       

     

       805
       805
       -
       let test_session_persistence () =

     

       806
       806
       -
         run @@ fun env ->

     

       807
       807
       -
         Eio.Switch.run @@ fun sw ->

     

       808
       808
       -
         let port = get_free_port () in

     

       809
       809
       -
         let base_url = Printf.sprintf "http://127.0.0.1:%d" port in

     

       810
       810
       -
       

     

       811
       811
       -
         let test_env = object

     

       812
       812
       -
           method clock = env#clock

     

       813
       813
       -
           method net = env#net

     

       814
       814
       -
           method sw = sw

     

       815
       815
       -
         end in

     

       816
       816
       -
         Test_server.start_server ~port test_env;

     

       817
       817
       -
       

     

       818
       818
       -
         let req = Requests.create ~sw env in

     

       819
       819
       -
       

     

       820
       820
       -
         let req = Requests.set_default_header req "X-Session" "session-123" in

     

       821
       821
       -
       

     

       822
       822
       -
         let auth = Requests.Auth.bearer ~token:"test_token" in

     

       823
       823
       -
         let req = Requests.set_auth req auth in

     

       824
       824
       -
       

     

       825
       825
       -
         let response1 = Requests.get req (base_url ^ "/echo") in

     

       826
       826
       -
         let body_str1 = Requests.Response.body response1 |> Eio.Flow.read_all in

     

       827
       827
       -
         let json1 = Yojson.Basic.from_string body_str1 in

     

       828
       828
       -
         let headers1 = json1 |> Yojson.Basic.Util.member "headers" in

     

       829
       829
       -
       

     

       830
       830
       -
         let session_header =

     

       831
       831
       -
           headers1

     

       832
       832
       -
           |> Yojson.Basic.Util.member "x-session"

     

       833
       833
       -
           |> Yojson.Basic.Util.to_string_option

     

       834
       834
       -
           |> Option.value ~default:""

     

       835
       835
       -
         in

     

       836
       836
       -
       

     

       837
       837
       -
         Alcotest.(check string) "Session header persisted" "session-123" session_header;

     

       838
       838
       -
       

     

       839
       839
       -
         let req = Requests.remove_default_header req "X-Session" in

     

       840
       840
       -
       

     

       841
       841
       -
         let response2 = Requests.get req (base_url ^ "/echo") in

     

       842
       842
       -
         let body_str2 = Requests.Response.body response2 |> Eio.Flow.read_all in

     

       843
       843
       -
         let json2 = Yojson.Basic.from_string body_str2 in

     

       844
       844
       -
         let headers2 = json2 |> Yojson.Basic.Util.member "headers" in

     

       845
       845
       -
       

     

       846
       846
       -
         let session_header2 =

     

       847
       847
       -
           headers2

     

       848
       848
       -
           |> Yojson.Basic.Util.member "x-session"

     

       849
       849
       -
           |> Yojson.Basic.Util.to_string_option

     

       850
       850
       -
         in

     

       851
       851
       -
       

     

       852
       852
       -
         Alcotest.(check (option string)) "Session header removed" None session_header2

     

       853
       853
       -
       

     

       854
       854
       -
       let () =

     

       855
       855
       -
         Logs.set_reporter (Logs.format_reporter ());

     

       856
       856
       -
         Logs.set_level (Some Logs.Warning);

     

       857
       857
       -
       

     

       858
       858
       -
         let open Alcotest in

     

       859
       859
       -
         run "Requests Tests" [

     

       860
       860
       -
           "HTTP Methods", [

     

       861
       861
       -
             test_case "GET request" `Quick test_get_request;

     

       862
       862
       -
             test_case "POST request" `Quick test_post_request;

     

       863
       863
       -
             test_case "PUT request" `Quick test_put_request;

     

       864
       864
       -
             test_case "DELETE request" `Quick test_delete_request;

     

       865
       865
       -
             test_case "PATCH request" `Quick test_patch_request;

     

       866
       866
       -
             test_case "HEAD request" `Quick test_head_request;

     

       867
       867
       -
             test_case "OPTIONS request" `Quick test_options_request;

     

       868
       868
       -
           ];

     

       869
       869
       -
           "Request Features", [

     

       870
       870
       -
             test_case "Custom headers" `Quick test_custom_headers;

     

       871
       871
       -
             test_case "Query parameters" `Quick test_query_params;

     

       872
       872
       -
             test_case "JSON body" `Quick test_json_body;

     

       873
       873
       -
             test_case "Form data" `Quick test_form_data;

     

       874
       874
       -
             test_case "Multipart upload" `Quick test_multipart;

     

       875
       875
       -
             test_case "Default headers" `Quick test_default_headers;

     

       876
       876
       -
           ];

     

       877
       877
       -
           "Response Handling", [

     

       878
       878
       -
             test_case "Status codes" `Quick test_status_codes;

     

       879
       879
       -
             test_case "Response headers" `Quick test_response_headers;

     

       880
       880
       -
             test_case "Large response" `Quick test_large_response;

     

       881
       881
       -
           ];

     

       882
       882
       -
           "Redirects", [

     

       883
       883
       -
             test_case "Follow redirects" `Quick test_redirects;

     

       884
       884
       -
             test_case "No follow redirects" `Quick test_no_redirect;

     

       885
       885
       -
           ];

     

       886
       886
       -
           "Authentication", [

     

       887
       887
       -
             test_case "Bearer auth" `Quick test_bearer_auth;

     

       888
       888
       -
             test_case "Basic auth" `Quick test_basic_auth;

     

       889
       889
       -
           ];

     

       890
       890
       -
           "Session Features", [

     

       891
       891
       -
             test_case "Cookies" `Quick test_cookies;

     

       892
       892
       -
             test_case "Session persistence" `Quick test_session_persistence;

     

       893
       893
       -
           ];

     

       894
       894
       -
           "Advanced", [

     

       895
       895
       -
             test_case "Timeout handling" `Quick test_timeout;

     

       896
       896
       -
             test_case "Concurrent requests" `Quick test_concurrent_requests;

     

       897
       897
       -
             test_case "One module" `Quick test_one_module;

     

       898
       898
       -
           ];

     

       899
       899
       -
         ]

+2 -1

stack/requests_json_api/dune-project

+1 -1

stack/requests_json_api/lib/dune

···

       1
       1
        
       (library

     

       2
       2
        
        (public_name requests_json_api)

     

       3
       3
        
        (name requests_json_api)

     

       4
       4
       -
        (libraries requests eio ezjsonm))

     

       4
       4
       +
        (libraries requests eio jsont jsont.bytesrw))

+83 -15

stack/requests_json_api/lib/requests_json_api.ml

···

       27
       27
        
       

     

       28
       28
        
       (** {1 JSON Helpers} *)

     

       29
       29
        
       

     

       30
       30
       -
       let parse_json parser body_str =

     

       31
       31
       -
         Ezjsonm.from_string body_str |> parser

     

       30
       30
       +
       let parse_json decoder body_str =

     

       31
       31
       +
         match Jsont_bytesrw.decode_string' decoder body_str with

     

       32
       32
       +
         | Ok v -> v

     

       33
       33
       +
         | Error e -> failwith (Fmt.str "JSON parse error: %s" (Jsont.Error.to_string e))

     

       32
       34
        
       

     

       33
       33
       -
       let parse_json_result parser body_str =

     

       34
       34
       -
         try Ok (parse_json parser body_str)

     

       35
       35
       -
         with exn -> Error (Printexc.to_string exn)

     

       35
       35
       +
       let parse_json_result decoder body_str =

     

       36
       36
       +
         match Jsont_bytesrw.decode_string' decoder body_str with

     

       37
       37
       +
         | Ok v -> Ok v

     

       38
       38
       +
         | Error e -> Error (Jsont.Error.to_string e)

     

       36
       39
        
       

     

       37
       37
       -
       let get_json_exn session url parser =

     

       40
       40
       +
       let get_json_exn session url decoder =

     

       38
       41
        
         let response = Requests.get session url in

     

       39
       42
        
         let status = Requests.Response.status_code response in

     

       40
       43
        
         if status < 200 || status >= 300 then

     

       41
       44
        
           failwith (Printf.sprintf "HTTP %d" status);

     

       42
       42
       -
         read_body response |> parse_json parser

     

       45
       45
       +
         read_body response |> parse_json decoder

     

       43
       46
        
       

     

       44
       44
       -
       let get_json session url parser =

     

       47
       47
       +
       let get_json session url decoder =

     

       45
       48
        
         match get_result session url with

     

       46
       49
        
         | Ok body ->

     

       47
       47
       -
             (match parse_json_result parser body with

     

       50
       50
       +
             (match parse_json_result decoder body with

     

       48
       51
        
              | Ok result -> Ok result

     

       49
       52
        
              | Error msg -> Error (`Json_error msg))

     

       50
       53
        
         | Error (status, body) -> Error (`Http (status, body))

     

       51
       54
        
       

     

       52
       52
       -
       let post_json session url json_value =

     

       53
       53
       -
         let body_str = Ezjsonm.value_to_string json_value in

     

       55
       55
       +
       let post_json session url jsont_codec value =

     

       56
       56
       +
         let body_str = match Jsont_bytesrw.encode_string' jsont_codec value with

     

       57
       57
       +
           | Ok s -> s

     

       58
       58
       +
           | Error e -> failwith (Fmt.str "JSON encoding error: %s" (Jsont.Error.to_string e))

     

       59
       59
       +
         in

     

       54
       60
        
         let body = Requests.Body.of_string Requests.Mime.json body_str in

     

       55
       61
        
         Requests.post session url ~body

     

       56
       62
        
       

     

       57
       57
       -
       let post_json_exn session url json_value =

     

       58
       58
       -
         let response = post_json session url json_value in

     

       63
       63
       +
       let post_json_exn session url jsont_codec value =

     

       64
       64
       +
         let response = post_json session url jsont_codec value in

     

       59
       65
        
         let status = Requests.Response.status_code response in

     

       60
       66
        
         if status < 200 || status >= 300 then

     

       61
       67
        
           failwith (Printf.sprintf "HTTP %d" status);

     

       62
       68
        
         read_body response

     

       63
       69
        
       

     

       64
       64
       -
       let post_json_result session url json_value =

     

       70
       70
       +
       let post_json_result session url jsont_codec value =

     

       65
       71
        
         try

     

       66
       66
       -
           let response = post_json session url json_value in

     

       72
       72
       +
           let response = post_json session url jsont_codec value in

     

       67
       73
        
           check_2xx response

     

       68
       74
        
         with exn ->

     

       69
       75
        
           Error (0, Printexc.to_string exn)

     

       76
       76
       +
       

     

       77
       77
       +
       let post_json_decode_exn session url ~req req_value ~resp =

     

       78
       78
       +
         let response = post_json session url req req_value in

     

       79
       79
       +
         let status = Requests.Response.status_code response in

     

       80
       80
       +
         if status < 200 || status >= 300 then

     

       81
       81
       +
           failwith (Printf.sprintf "HTTP %d" status);

     

       82
       82
       +
         read_body response |> parse_json resp

     

       83
       83
       +
       

     

       84
       84
       +
       let post_json_decode session url ~req req_value ~resp =

     

       85
       85
       +
         try

     

       86
       86
       +
           let response = post_json session url req req_value in

     

       87
       87
       +
           match check_2xx response with

     

       88
       88
       +
           | Ok body ->

     

       89
       89
       +
               (match parse_json_result resp body with

     

       90
       90
       +
                | Ok result -> Ok result

     

       91
       91
       +
                | Error msg -> Error (`Json_error msg))

     

       92
       92
       +
           | Error (status, body) -> Error (`Http (status, body))

     

       93
       93
       +
         with exn ->

     

       94
       94
       +
           Error (`Http (0, Printexc.to_string exn))

     

       95
       95
       +
       

     

       96
       96
       +
       let put_json_exn session url jsont_codec value =

     

       97
       97
       +
         let body_str = match Jsont_bytesrw.encode_string' jsont_codec value with

     

       98
       98
       +
           | Ok s -> s

     

       99
       99
       +
           | Error e -> failwith (Fmt.str "JSON encoding error: %s" (Jsont.Error.to_string e))

     

       100
       100
       +
         in

     

       101
       101
       +
         let body = Requests.Body.of_string Requests.Mime.json body_str in

     

       102
       102
       +
         let response = Requests.put session url ~body in

     

       103
       103
       +
         let status = Requests.Response.status_code response in

     

       104
       104
       +
         if status < 200 || status >= 300 then

     

       105
       105
       +
           failwith (Printf.sprintf "HTTP %d" status);

     

       106
       106
       +
         read_body response

     

       107
       107
       +
       

     

       108
       108
       +
       let put_json_decode_exn session url ~req req_value ~resp =

     

       109
       109
       +
         let body_str = match Jsont_bytesrw.encode_string' req req_value with

     

       110
       110
       +
           | Ok s -> s

     

       111
       111
       +
           | Error e -> failwith (Fmt.str "JSON encoding error: %s" (Jsont.Error.to_string e))

     

       112
       112
       +
         in

     

       113
       113
       +
         let body = Requests.Body.of_string Requests.Mime.json body_str in

     

       114
       114
       +
         let response = Requests.put session url ~body in

     

       115
       115
       +
         let status = Requests.Response.status_code response in

     

       116
       116
       +
         if status < 200 || status >= 300 then

     

       117
       117
       +
           failwith (Printf.sprintf "HTTP %d" status);

     

       118
       118
       +
         read_body response |> parse_json resp

     

       119
       119
       +
       

     

       120
       120
       +
       let patch_json_exn session url jsont_codec value =

     

       121
       121
       +
         let body_str = match Jsont_bytesrw.encode_string' jsont_codec value with

     

       122
       122
       +
           | Ok s -> s

     

       123
       123
       +
           | Error e -> failwith (Fmt.str "JSON encoding error: %s" (Jsont.Error.to_string e))

     

       124
       124
       +
         in

     

       125
       125
       +
         let body = Requests.Body.of_string Requests.Mime.json body_str in

     

       126
       126
       +
         let response = Requests.patch session url ~body in

     

       127
       127
       +
         let status = Requests.Response.status_code response in

     

       128
       128
       +
         if status < 200 || status >= 300 then

     

       129
       129
       +
           failwith (Printf.sprintf "HTTP %d" status);

     

       130
       130
       +
         read_body response

     

       131
       131
       +
       

     

       132
       132
       +
       let delete_json_exn session url =

     

       133
       133
       +
         let response = Requests.delete session url in

     

       134
       134
       +
         let status = Requests.Response.status_code response in

     

       135
       135
       +
         if status < 200 || status >= 300 then

     

       136
       136
       +
           failwith (Printf.sprintf "HTTP %d" status);

     

       137
       137
       +
         read_body response

     

       70
       138
        
       

     

       71
       139
        
       (** {1 URL Helpers} *)

     

       72
       140

+50 -12

stack/requests_json_api/lib/requests_json_api.mli

···

       8
       8
        
           {[

     

       9
       9
        
             open Requests_json_api

     

       10
       10
        
       

     

       11
       11
       +
             (* Define a Jsont codec for your type *)

     

       12
       12
       +
             type user = { id : int; name : string }

     

       13
       13
       +
       

     

       14
       14
       +
             let user_jsont =

     

       15
       15
       +
               Jsont.Object.map (fun id name -> { id; name })

     

       16
       16
       +
               |> Jsont.Object.mem "id" Jsont.int ~enc:(fun u -> u.id)

     

       17
       17
       +
               |> Jsont.Object.mem "name" Jsont.string ~enc:(fun u -> u.name)

     

       18
       18
       +
               |> Jsont.Object.finish

     

       19
       19
       +
       

     

       20
       20
       +
             let users_jsont = Jsont.list user_jsont

     

       21
       21
       +
       

     

       11
       22
        
             let fetch_users session =

     

       12
       12
       -
               get_json_exn session (base_url / "users") parse_users

     

       23
       23
       +
               get_json_exn session (base_url / "users") users_jsont

     

       13
       24
        
           ]}

     

       14
       25
        
       *)

     

       15
       26
        
       

     

       16
       27
        
       (** {1 JSON Request Helpers} *)

     

       17
       28
        
       

     

       18
       18
       -
       val get_json_exn : (_ Eio.Time.clock, _ Eio.Net.t) Requests.t -> string -> (Ezjsonm.value -> 'a) -> 'a

     

       19
       19
       -
       (** [get_json_exn session url parser] makes a GET request, checks status is 2xx,

     

       20
       20
       -
           reads and parses JSON body, then applies the parser function.

     

       29
       29
       +
       val get_json_exn : (_ Eio.Time.clock, _ Eio.Net.t) Requests.t -> string -> 'a Jsont.t -> 'a

     

       30
       30
       +
       (** [get_json_exn session url decoder] makes a GET request, checks status is 2xx,

     

       31
       31
       +
           reads and parses JSON body using the provided Jsont decoder.

     

       21
       32
        
           Raises [Failure] on any error (HTTP, network, or JSON parse). *)

     

       22
       33
        
       

     

       23
       23
       -
       val get_json : (_ Eio.Time.clock, _ Eio.Net.t) Requests.t -> string -> (Ezjsonm.value -> 'a) ->

     

       34
       34
       +
       val get_json : (_ Eio.Time.clock, _ Eio.Net.t) Requests.t -> string -> 'a Jsont.t ->

     

       24
       35
        
         ('a, [> `Http of int * string | `Json_error of string]) result

     

       25
       36
        
       (** Like [get_json_exn] but returns [Result] instead of raising exceptions.

     

       26
       37
        
           Returns [Ok parsed_value] on success, or [Error] with details on failure. *)

     

       27
       38
        
       

     

       28
       28
       -
       val post_json : (_ Eio.Time.clock, _ Eio.Net.t) Requests.t -> string -> Ezjsonm.value -> Requests.Response.t

     

       29
       29
       -
       (** [post_json session url json_value] creates a JSON request body and POSTs it to the URL.

     

       39
       39
       +
       val post_json : (_ Eio.Time.clock, _ Eio.Net.t) Requests.t -> string -> 'a Jsont.t -> 'a -> Requests.Response.t

     

       40
       40
       +
       (** [post_json session url codec value] encodes [value] using the Jsont codec and POSTs it to the URL.

     

       30
       41
        
           Returns the raw response for custom handling. *)

     

       31
       42
        
       

     

       32
       32
       -
       val post_json_exn : (_ Eio.Time.clock, _ Eio.Net.t) Requests.t -> string -> Ezjsonm.value -> string

     

       43
       43
       +
       val post_json_exn : (_ Eio.Time.clock, _ Eio.Net.t) Requests.t -> string -> 'a Jsont.t -> 'a -> string

     

       33
       44
        
       (** Like [post_json] but checks status is 2xx and returns the response body as a string.

     

       34
       45
        
           Raises [Failure] on non-2xx status. *)

     

       35
       46
        
       

     

       36
       36
       -
       val post_json_result : (_ Eio.Time.clock, _ Eio.Net.t) Requests.t -> string -> Ezjsonm.value ->

     

       47
       47
       +
       val post_json_result : (_ Eio.Time.clock, _ Eio.Net.t) Requests.t -> string -> 'a Jsont.t -> 'a ->

     

       37
       48
        
         (string, int * string) result

     

       38
       49
        
       (** Like [post_json_exn] but returns [Result] instead of raising.

     

       39
       50
        
           [Ok body] on 2xx status, [Error (status, body)] otherwise. *)

     

       40
       51
        
       

     

       52
       52
       +
       val post_json_decode_exn : (_ Eio.Time.clock, _ Eio.Net.t) Requests.t -> string ->

     

       53
       53
       +
         req:'a Jsont.t -> 'a -> resp:'b Jsont.t -> 'b

     

       54
       54
       +
       (** [post_json_decode_exn session url ~req req_value ~resp] encodes [req_value] using the [req] codec,

     

       55
       55
       +
           POSTs it to the URL, checks status is 2xx, and decodes the response using the [resp] codec.

     

       56
       56
       +
           Raises [Failure] on any error. *)

     

       57
       57
       +
       

     

       58
       58
       +
       val post_json_decode : (_ Eio.Time.clock, _ Eio.Net.t) Requests.t -> string ->

     

       59
       59
       +
         req:'a Jsont.t -> 'a -> resp:'b Jsont.t ->

     

       60
       60
       +
         ('b, [> `Http of int * string | `Json_error of string]) result

     

       61
       61
       +
       (** Like [post_json_decode_exn] but returns [Result] instead of raising. *)

     

       62
       62
       +
       

     

       63
       63
       +
       val put_json_exn : (_ Eio.Time.clock, _ Eio.Net.t) Requests.t -> string -> 'a Jsont.t -> 'a -> string

     

       64
       64
       +
       (** [put_json_exn session url codec value] encodes [value] and PUTs it to the URL.

     

       65
       65
       +
           Returns response body. Raises [Failure] on non-2xx status. *)

     

       66
       66
       +
       

     

       67
       67
       +
       val put_json_decode_exn : (_ Eio.Time.clock, _ Eio.Net.t) Requests.t -> string ->

     

       68
       68
       +
         req:'a Jsont.t -> 'a -> resp:'b Jsont.t -> 'b

     

       69
       69
       +
       (** Like [post_json_decode_exn] but uses PUT method. *)

     

       70
       70
       +
       

     

       71
       71
       +
       val patch_json_exn : (_ Eio.Time.clock, _ Eio.Net.t) Requests.t -> string -> 'a Jsont.t -> 'a -> string

     

       72
       72
       +
       (** [patch_json_exn session url codec value] encodes [value] and PATCHes it to the URL.

     

       73
       73
       +
           Returns response body. Raises [Failure] on non-2xx status. *)

     

       74
       74
       +
       

     

       75
       75
       +
       val delete_json_exn : (_ Eio.Time.clock, _ Eio.Net.t) Requests.t -> string -> string

     

       76
       76
       +
       (** [delete_json_exn session url] makes a DELETE request.

     

       77
       77
       +
           Returns response body. Raises [Failure] on non-2xx status. *)

     

       78
       78
       +
       

     

       41
       79
        
       (** {1 JSON Parsing Helpers} *)

     

       42
       80
        
       

     

       43
       43
       -
       val parse_json : (Ezjsonm.value -> 'a) -> string -> 'a

     

       44
       44
       -
       (** [parse_json parser body_str] parses a JSON string and applies the parser function.

     

       81
       81
       +
       val parse_json : 'a Jsont.t -> string -> 'a

     

       82
       82
       +
       (** [parse_json decoder body_str] parses a JSON string using the provided Jsont decoder.

     

       45
       83
        
           Raises exception on parse error. *)

     

       46
       84
        
       

     

       47
       47
       -
       val parse_json_result : (Ezjsonm.value -> 'a) -> string -> ('a, string) result

     

       85
       85
       +
       val parse_json_result : 'a Jsont.t -> string -> ('a, string) result

     

       48
       86
        
       (** Like [parse_json] but returns [Result] on parse error instead of raising. *)

     

       49
       87
        
       

     

       50
       88
        
       (** {1 Low-Level Helpers} *)

+2 -1

stack/requests_json_api/requests_json_api.opam

···

       13
       13
        
         "dune" {>= "3.0"}

     

       14
       14
        
         "requests"

     

       15
       15
        
         "eio"

     

       16
       16
       -
         "ezjsonm"

     

       16
       16
       +
         "jsont"

     

       17
       17
       +
         "bytesrw"

     

       17
       18
        
         "odoc" {with-doc}

     

       18
       19
        
       ]

     

       19
       20
        
       build: [

+1 -1

stack/river/bin/dune

···

       1
       1
        
       (executable

     

       2
       2
        
        (public_name river-cli)

     

       3
       3
        
        (name river_cli)

     

       4
       4
       -
        (libraries river cmdliner yojson fmt fmt.tty fmt.cli eio eio_main eiocmd unix ptime syndic xdge))

     

       4
       4
       +
        (libraries river cmdliner jsont jsont.bytesrw fmt fmt.tty fmt.cli eio eio_main eiocmd unix ptime syndic xdge))

+36 -38

stack/river/bin/river_cli.ml

···

       38
       38
        
             with Eio.Io (Eio.Fs.E (Already_exists _), _) -> ()

     

       39
       39
        
           ) dirs

     

       40
       40
        
       

     

       41
       41
       -
         let user_of_json json =

     

       42
       42
       -
           let open Yojson.Safe.Util in

     

       43
       43
       -
           try

     

       44
       44
       -
             let feeds_json = json |> member "feeds" |> to_list in

     

       45
       45
       -
             let feeds = List.map (fun feed ->

     

       46
       46
       -
               { River.name = feed |> member "name" |> to_string;

     

       47
       47
       -
                 url = feed |> member "url" |> to_string }

     

       48
       48
       -
             ) feeds_json in

     

       49
       49
       -
             Some {

     

       50
       50
       -
               username = json |> member "username" |> to_string;

     

       51
       51
       -
               fullname = json |> member "fullname" |> to_string;

     

       52
       52
       -
               email = json |> member "email" |> to_string_option;

     

       53
       53
       -
               feeds;

     

       54
       54
       -
               last_synced = json |> member "last_synced" |> to_string_option;

     

       55
       55
       -
             }

     

       56
       56
       -
           with _ -> None

     

       41
       41
       +
         (* JSON codecs for user data *)

     

       42
       42
       +
       

     

       43
       43
       +
         (* Codec for River.source (feed) *)

     

       44
       44
       +
         let source_jsont =

     

       45
       45
       +
           let make name url = { River.name; url } in

     

       46
       46
       +
           Jsont.Object.map ~kind:"Source" make

     

       47
       47
       +
           |> Jsont.Object.mem "name" Jsont.string ~enc:(fun s -> s.River.name)

     

       48
       48
       +
           |> Jsont.Object.mem "url" Jsont.string ~enc:(fun s -> s.River.url)

     

       49
       49
       +
           |> Jsont.Object.finish

     

       50
       50
       +
       

     

       51
       51
       +
         (* Codec for user *)

     

       52
       52
       +
         let user_jsont =

     

       53
       53
       +
           let make username fullname email feeds last_synced =

     

       54
       54
       +
             { username; fullname; email; feeds; last_synced }

     

       55
       55
       +
           in

     

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

     

       57
       57
       +
           |> Jsont.Object.mem "username" Jsont.string ~enc:(fun u -> u.username)

     

       58
       58
       +
           |> Jsont.Object.mem "fullname" Jsont.string ~enc:(fun u -> u.fullname)

     

       59
       59
       +
           |> Jsont.Object.opt_mem "email" Jsont.string ~enc:(fun u -> u.email)

     

       60
       60
       +
           |> Jsont.Object.mem "feeds" (Jsont.list source_jsont) ~enc:(fun u -> u.feeds)

     

       61
       61
       +
           |> Jsont.Object.opt_mem "last_synced" Jsont.string ~enc:(fun u -> u.last_synced)

     

       62
       62
       +
           |> Jsont.Object.finish

     

       63
       63
       +
       

     

       64
       64
       +
         let user_of_string s =

     

       65
       65
       +
           match Jsont_bytesrw.decode_string' user_jsont s with

     

       66
       66
       +
           | Ok user -> Some user

     

       67
       67
       +
           | Error err ->

     

       68
       68
       +
               Log.err (fun m -> m "Failed to parse user JSON: %s" (Jsont.Error.to_string err));

     

       69
       69
       +
               None

     

       70
       70
       +
       

     

       71
       71
       +
         let user_to_string user =

     

       72
       72
       +
           match Jsont_bytesrw.encode_string' ~format:Jsont.Indent user_jsont user with

     

       73
       73
       +
           | Ok s -> s

     

       74
       74
       +
           | Error err -> failwith ("Failed to encode user: " ^ Jsont.Error.to_string err)

     

       57
       75
        
       

     

       58
       76
        
         let load_user state username =

     

       59
       77
        
           let file = user_file state username in

     

       60
       78
        
           try

     

       61
       79
        
             let content = Eio.Path.load file in

     

       62
       62
       -
             let json = Yojson.Safe.from_string content in

     

       63
       63
       -
             user_of_json json

     

       80
       80
       +
             user_of_string content

     

       64
       81
        
           with

     

       65
       82
        
           | Eio.Io (Eio.Fs.E (Not_found _), _) -> None

     

       66
       83
        
           | e ->

     

       67
       84
        
             Log.err (fun m -> m "Error loading user %s: %s" username (Printexc.to_string e));

     

       68
       85
        
             None

     

       69
       86
        
       

     

       70
       70
       -
         let user_to_json user =

     

       71
       71
       -
           let feeds_json = List.map (fun feed ->

     

       72
       72
       -
             `Assoc [

     

       73
       73
       -
               "name", `String feed.River.name;

     

       74
       74
       -
               "url", `String feed.River.url;

     

       75
       75
       -
             ]

     

       76
       76
       -
           ) user.feeds in

     

       77
       77
       -
           `Assoc [

     

       78
       78
       -
             "username", `String user.username;

     

       79
       79
       -
             "fullname", `String user.fullname;

     

       80
       80
       -
             "email", (match user.email with

     

       81
       81
       -
               | Some e -> `String e

     

       82
       82
       -
               | None -> `Null);

     

       83
       83
       -
             "feeds", `List feeds_json;

     

       84
       84
       -
             "last_synced", (match user.last_synced with

     

       85
       85
       -
               | Some s -> `String s

     

       86
       86
       -
               | None -> `Null);

     

       87
       87
       -
           ]

     

       88
       88
       -
       

     

       89
       87
        
         let save_user state user =

     

       90
       88
        
           let file = user_file state user.username in

     

       91
       91
       -
           let json = user_to_json user |> Yojson.Safe.to_string ~std:true in

     

       89
       89
       +
           let json = user_to_string user in

     

       92
       90
        
           Eio.Path.save ~create:(`Or_truncate 0o644) file json

     

       93
       91
        
       

     

       94
       92
        
         let list_users state =

+1 -2

stack/river/dune-project

···

       37
       37
        
         lambdasoup

     

       38
       38
        
         uri

     

       39
       39
        
         (cmdliner (>= 2.0.0))

     

       40
       40
       -
         yojson

     

       41
       40
        
         fmt

     

       42
       41
        
         xdge

     

       43
       42
        
         (jsonfeed (>= 1.1.0))

     

       44
       43
        
         (jsont (>= 0.2.0))

     

       45
       45
       -
         bytesrw

     

       44
       44
       +
         (jsont.bytesrw (>= 0.2.0))

     

       46
       45
        
         (odoc :with-doc)))

+1 -1

stack/river/lib/dune

···

       2
       2
        
        (name river)

     

       3
       3
        
        (public_name river)

     

       4
       4
        
        (wrapped false)

     

       5
       5
       -
        (libraries eio eio_main requests requests_json_api logs str syndic lambdasoup uri ptime jsonfeed jsont bytesrw))

     

       5
       5
       +
        (libraries eio eio_main requests requests_json_api logs str syndic lambdasoup uri ptime jsonfeed jsont jsont.bytesrw cacheio xdge))

+264 -189

stack/river/lib/river_store.ml

···

       1
       1
        
       (*

     

       2
       2
       -
        * Persistent storage for Atom feed entries using Cacheio

     

       2
       2
       +
        * Persistent storage for Atom feed entries using Cacheio and Jsonfeed

     

       3
       3
        
        *)

     

       4
       4
        
       

     

       5
       5
        
       let src = Logs.Src.create "river.store" ~doc:"River persistent storage"

     
···

       7
       7
        
       

     

       8
       8
        
       (* Types *)

     

       9
       9
        
       

     

       10
       10
       -
       type stored_entry = {

     

       11
       11
       -
         atom_id : string;

     

       12
       12
       -
         title : string;

     

       13
       13
       -
         link : Uri.t option;

     

       14
       14
       -
         published : Ptime.t option;

     

       15
       15
       -
         updated : Ptime.t;

     

       16
       16
       -
         author_name : string;

     

       17
       17
       -
         author_email : string option;

     

       18
       18
       -
         content : string;

     

       10
       10
       +
       (* Storage metadata that extends Jsonfeed.Item via unknown fields *)

     

       11
       11
       +
       type storage_meta = {

     

       19
       12
        
         feed_url : string;

     

       20
       13
        
         feed_name : string;

     

       21
       14
        
         feed_title : string;

     

       22
       15
        
         stored_at : Ptime.t;

     

       23
       23
       -
         tags : string list;

     

       24
       24
       -
         summary : string option;

     

       16
       16
       +
       }

     

       17
       17
       +
       

     

       18
       18
       +
       (* A stored entry is a Jsonfeed.Item.t with storage metadata in unknown fields *)

     

       19
       19
       +
       type stored_entry = {

     

       20
       20
       +
         item : Jsonfeed.Item.t;

     

       21
       21
       +
         meta : storage_meta;

     

       25
       22
        
       }

     

       23
       23
       +
       

     

       24
       24
       +
       (* Stored entry accessors *)

     

       25
       25
       +
       let entry_item entry = entry.item

     

       26
       26
       +
       let entry_feed_url entry = entry.meta.feed_url

     

       27
       27
       +
       let entry_feed_name entry = entry.meta.feed_name

     

       28
       28
       +
       let entry_feed_title entry = entry.meta.feed_title

     

       29
       29
       +
       let entry_stored_at entry = entry.meta.stored_at

     

       26
       30
        
       

     

       27
       31
        
       type feed_info = {

     

       28
       32
        
         url : string;

     
···

       54
       58
        
         let feed_key = make_feed_key feed_url in

     

       55
       59
        
         feed_key ^ "/meta.json"

     

       56
       60
        
       

     

       57
       57
       -
       (* JSON serialization *)

     

       61
       61
       +
       (* JSON serialization using Jsonfeed and Jsont *)

     

       58
       62
        
       

     

       59
       59
       -
       let entry_to_json entry =

     

       60
       60
       -
         `Assoc [

     

       61
       61
       -
           "atom_id", `String entry.atom_id;

     

       62
       62
       -
           "title", `String entry.title;

     

       63
       63
       -
           "link", (match entry.link with

     

       64
       64
       -
             | Some u -> `String (Uri.to_string u)

     

       65
       65
       -
             | None -> `Null);

     

       66
       66
       -
           "published", (match entry.published with

     

       67
       67
       -
             | Some t -> `String (Ptime.to_rfc3339 t)

     

       68
       68
       -
             | None -> `Null);

     

       69
       69
       -
           "updated", `String (Ptime.to_rfc3339 entry.updated);

     

       70
       70
       -
           "author_name", `String entry.author_name;

     

       71
       71
       -
           "author_email", (match entry.author_email with Some e -> `String e | None -> `Null);

     

       72
       72
       -
           "content", `String entry.content;

     

       73
       73
       -
           "feed_url", `String entry.feed_url;

     

       74
       74
       -
           "feed_name", `String entry.feed_name;

     

       75
       75
       -
           "feed_title", `String entry.feed_title;

     

       76
       76
       -
           "stored_at", `String (Ptime.to_rfc3339 entry.stored_at);

     

       77
       77
       -
           "tags", `List (List.map (fun t -> `String t) entry.tags);

     

       78
       78
       -
           "summary", (match entry.summary with Some s -> `String s | None -> `Null);

     

       79
       79
       -
         ]

     

       63
       63
       +
       (* Storage metadata codec - stores feed info and storage timestamp *)

     

       64
       64
       +
       let storage_meta_jsont : storage_meta Jsont.t =

     

       65
       65
       +
         Jsont.Object.(

     

       66
       66
       +
           map ~kind:"StorageMeta" (fun feed_url feed_name feed_title stored_at : storage_meta ->

     

       67
       67
       +
             { feed_url; feed_name; feed_title; stored_at })

     

       68
       68
       +
           |> mem "x_river_feed_url" Jsont.string ~enc:(fun m -> m.feed_url)

     

       69
       69
       +
           |> mem "x_river_feed_name" Jsont.string ~enc:(fun m -> m.feed_name)

     

       70
       70
       +
           |> mem "x_river_feed_title" Jsont.string ~enc:(fun m -> m.feed_title)

     

       71
       71
       +
           |> mem "x_river_stored_at" Jsonfeed.Rfc3339.jsont ~enc:(fun m -> m.stored_at)

     

       72
       72
       +
           |> finish

     

       73
       73
       +
         )

     

       80
       74
        
       

     

       81
       81
       -
       let entry_of_json json =

     

       82
       82
       -
         let open Yojson.Safe.Util in

     

       83
       83
       -
         let parse_time s =

     

       84
       84
       -
           match Ptime.of_rfc3339 s with

     

       85
       85
       -
           | Ok (t, _, _) -> t

     

       86
       86
       -
           | Error _ -> failwith ("Invalid timestamp: " ^ s)

     

       75
       75
       +
       (* Codec for feed_info *)

     

       76
       76
       +
       let feed_meta_jsont : feed_info Jsont.t =

     

       77
       77
       +
         Jsont.Object.(

     

       78
       78
       +
           map ~kind:"FeedInfo" (fun url name title last_updated entry_count : feed_info ->

     

       79
       79
       +
             { url; name; title; last_updated; entry_count })

     

       80
       80
       +
           |> mem "url" Jsont.string ~enc:(fun (m : feed_info) -> m.url)

     

       81
       81
       +
           |> mem "name" Jsont.string ~enc:(fun m -> m.name)

     

       82
       82
       +
           |> mem "title" Jsont.string ~enc:(fun m -> m.title)

     

       83
       83
       +
           |> mem "last_updated" Jsonfeed.Rfc3339.jsont ~enc:(fun m -> m.last_updated)

     

       84
       84
       +
           |> mem "entry_count" Jsont.int ~enc:(fun m -> m.entry_count)

     

       85
       85
       +
           |> finish

     

       86
       86
       +
         )

     

       87
       87
       +
       

     

       88
       88
       +
       (* Helper to create item with storage metadata in unknown fields *)

     

       89
       89
       +
       let merge_storage_meta item meta =

     

       90
       90
       +
         let meta_json = Jsont_bytesrw.encode_string' storage_meta_jsont meta

     

       91
       91
       +
                         |> Result.get_ok in

     

       92
       92
       +
         let meta_unknown = Jsont_bytesrw.decode_string' Jsont.json meta_json

     

       93
       93
       +
                            |> Result.get_ok in

     

       94
       94
       +
         Jsonfeed.Item.create

     

       95
       95
       +
           ~id:(Jsonfeed.Item.id item)

     

       96
       96
       +
           ~content:(Jsonfeed.Item.content item)

     

       97
       97
       +
           ?url:(Jsonfeed.Item.url item)

     

       98
       98
       +
           ?external_url:(Jsonfeed.Item.external_url item)

     

       99
       99
       +
           ?title:(Jsonfeed.Item.title item)

     

       100
       100
       +
           ?summary:(Jsonfeed.Item.summary item)

     

       101
       101
       +
           ?image:(Jsonfeed.Item.image item)

     

       102
       102
       +
           ?banner_image:(Jsonfeed.Item.banner_image item)

     

       103
       103
       +
           ?date_published:(Jsonfeed.Item.date_published item)

     

       104
       104
       +
           ?date_modified:(Jsonfeed.Item.date_modified item)

     

       105
       105
       +
           ?authors:(Jsonfeed.Item.authors item)

     

       106
       106
       +
           ?tags:(Jsonfeed.Item.tags item)

     

       107
       107
       +
           ?language:(Jsonfeed.Item.language item)

     

       108
       108
       +
           ?attachments:(Jsonfeed.Item.attachments item)

     

       109
       109
       +
           ?references:(Jsonfeed.Item.references item)

     

       110
       110
       +
           ~unknown:meta_unknown

     

       111
       111
       +
           ()

     

       112
       112
       +
       

     

       113
       113
       +
       (* Helper to extract storage metadata from item's unknown fields *)

     

       114
       114
       +
       let extract_storage_meta item =

     

       115
       115
       +
         let unknown = Jsonfeed.Item.unknown item in

     

       116
       116
       +
         let meta_str = Jsont_bytesrw.encode_string' Jsont.json unknown |> Result.get_ok in

     

       117
       117
       +
         match Jsont_bytesrw.decode_string' storage_meta_jsont meta_str with

     

       118
       118
       +
         | Ok meta -> meta

     

       119
       119
       +
         | Error e -> failwith ("Missing storage metadata: " ^ Jsont.Error.to_string e)

     

       120
       120
       +
       

     

       121
       121
       +
       (* Stored entry codec - just wraps Jsonfeed.Item.jsont *)

     

       122
       122
       +
       let stored_entry_jsont : stored_entry Jsont.t =

     

       123
       123
       +
         let kind = "StoredEntry" in

     

       124
       124
       +
         let of_string s =

     

       125
       125
       +
           match Jsont_bytesrw.decode_string' Jsonfeed.Item.jsont s with

     

       126
       126
       +
           | Ok item -> Ok { item; meta = extract_storage_meta item }

     

       127
       127
       +
           | Error e -> Error (Jsont.Error.to_string e)

     

       128
       128
       +
         in

     

       129
       129
       +
         let enc entry =

     

       130
       130
       +
           let item_with_meta = merge_storage_meta entry.item entry.meta in

     

       131
       131
       +
           match Jsont_bytesrw.encode_string' Jsonfeed.Item.jsont item_with_meta with

     

       132
       132
       +
           | Ok s -> s

     

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

     

       87
       134
        
         in

     

       88
       88
       -
         {

     

       89
       89
       -
           atom_id = json |> member "atom_id" |> to_string;

     

       90
       90
       -
           title = json |> member "title" |> to_string;

     

       91
       91
       -
           link = json |> member "link" |> to_string_option |> Option.map Uri.of_string;

     

       92
       92
       -
           published = json |> member "published" |> to_string_option |> Option.map parse_time;

     

       93
       93
       -
           updated = json |> member "updated" |> to_string |> parse_time;

     

       94
       94
       -
           author_name = json |> member "author_name" |> to_string;

     

       95
       95
       -
           author_email = json |> member "author_email" |> to_string_option;

     

       96
       96
       -
           content = json |> member "content" |> to_string;

     

       97
       97
       -
           feed_url = json |> member "feed_url" |> to_string;

     

       98
       98
       -
           feed_name = json |> member "feed_name" |> to_string;

     

       99
       99
       -
           feed_title = json |> member "feed_title" |> to_string;

     

       100
       100
       -
           stored_at = json |> member "stored_at" |> to_string |> parse_time;

     

       101
       101
       -
           tags = (try json |> member "tags" |> to_list |> List.map to_string with _ -> []);

     

       102
       102
       -
           summary = (try json |> member "summary" |> to_string_option with _ -> None);

     

       103
       103
       -
         }

     

       135
       135
       +
         Jsont.of_of_string ~kind of_string ~enc

     

       136
       136
       +
       

     

       137
       137
       +
       (* Encode/decode functions *)

     

       138
       138
       +
       let entry_to_string entry =

     

       139
       139
       +
         match Jsont_bytesrw.encode_string' stored_entry_jsont entry with

     

       140
       140
       +
         | Ok s -> s

     

       141
       141
       +
         | Error err -> failwith ("Failed to encode entry: " ^ Jsont.Error.to_string err)

     

       142
       142
       +
       

     

       143
       143
       +
       let entry_of_string s =

     

       144
       144
       +
         match Jsont_bytesrw.decode_string' stored_entry_jsont s with

     

       145
       145
       +
         | Ok entry -> entry

     

       146
       146
       +
         | Error err -> failwith ("Failed to parse entry: " ^ Jsont.Error.to_string err)

     

       104
       147
        
       

     

       105
       105
       -
       let feed_meta_to_json meta =

     

       106
       106
       -
         `Assoc [

     

       107
       107
       -
           "url", `String meta.url;

     

       108
       108
       -
           "name", `String meta.name;

     

       109
       109
       -
           "title", `String meta.title;

     

       110
       110
       -
           "last_updated", `String (Ptime.to_rfc3339 meta.last_updated);

     

       111
       111
       -
         ]

     

       148
       148
       +
       let feed_meta_to_string meta =

     

       149
       149
       +
         match Jsont_bytesrw.encode_string' feed_meta_jsont meta with

     

       150
       150
       +
         | Ok s -> s

     

       151
       151
       +
         | Error err -> failwith ("Failed to encode feed metadata: " ^ Jsont.Error.to_string err)

     

       112
       152
        
       

     

       113
       113
       -
       let feed_meta_of_json json =

     

       114
       114
       -
         let open Yojson.Safe.Util in

     

       115
       115
       -
         let parse_time s =

     

       116
       116
       -
           match Ptime.of_rfc3339 s with

     

       117
       117
       -
           | Ok (t, _, _) -> t

     

       118
       118
       -
           | Error _ -> failwith ("Invalid timestamp: " ^ s)

     

       119
       119
       -
         in

     

       120
       120
       -
         {

     

       121
       121
       -
           url = json |> member "url" |> to_string;

     

       122
       122
       -
           name = json |> member "name" |> to_string;

     

       123
       123
       -
           title = json |> member "title" |> to_string;

     

       124
       124
       -
           last_updated = json |> member "last_updated" |> to_string |> parse_time;

     

       125
       125
       -
           entry_count = 0; (* Will be counted separately *)

     

       126
       126
       -
         }

     

       153
       153
       +
       let feed_meta_of_string s =

     

       154
       154
       +
         match Jsont_bytesrw.decode_string' feed_meta_jsont s with

     

       155
       155
       +
         | Ok meta -> meta

     

       156
       156
       +
         | Error err -> failwith ("Failed to parse feed metadata: " ^ Jsont.Error.to_string err)

     

       127
       157
        
       

     

       128
       158
        
       (* Store creation *)

     

       129
       159
        
       

     
···

       142
       172
        
         Log.info (fun m -> m "Created River store with XDG at %a" Eio.Path.pp base_dir);

     

       143
       173
        
         { cache; base_dir }

     

       144
       174
        
       

     

       145
       145
       -
       (* Convert Post.t to stored_entry *)

     

       146
       146
       -
       let entry_of_post ~feed_url ~feed_name ~feed_title (post : Post.t) =

     

       147
       147
       -
         let atom_id = post.id in  (* Use the post's unique ID *)

     

       148
       148
       -
         let updated = match post.date with

     

       149
       149
       -
           | Some d -> d

     

       150
       150
       -
           | None -> Ptime.of_float_s (Unix.gettimeofday ()) |> Option.get

     

       175
       175
       +
       (* Convert Post.t to Jsonfeed.Item.t *)

     

       176
       176
       +
       let item_of_post ~feed_url ~feed_name ~feed_title (post : Post.t) =

     

       177
       177
       +
         let content =

     

       178
       178
       +
           let html = Soup.to_string post.content in

     

       179
       179
       +
           `Html html

     

       151
       180
        
         in

     

       152
       152
       -
         let published = post.date in

     

       153
       153
       -
         {

     

       154
       154
       -
           atom_id;

     

       155
       155
       -
           title = post.title;

     

       156
       156
       -
           link = post.link;

     

       157
       157
       -
           published;

     

       158
       158
       -
           updated;

     

       159
       159
       -
           author_name = post.author;

     

       160
       160
       -
           author_email = if post.email = "" then None else Some post.email;

     

       161
       161
       -
           content = Soup.to_string post.content;

     

       181
       181
       +
         let url = Option.map Uri.to_string post.link in

     

       182
       182
       +
         let authors =

     

       183
       183
       +
           if post.author = "" then None

     

       184
       184
       +
           else Some [Jsonfeed.Author.create ~name:post.author ()]

     

       185
       185
       +
         in

     

       186
       186
       +
         let tags = if post.tags = [] then None else Some post.tags in

     

       187
       187
       +
         let item = Jsonfeed.Item.create

     

       188
       188
       +
           ~id:post.id

     

       189
       189
       +
           ~content

     

       190
       190
       +
           ?url

     

       191
       191
       +
           ?title:(if post.title = "" then None else Some post.title)

     

       192
       192
       +
           ?summary:post.summary

     

       193
       193
       +
           ?date_published:post.date

     

       194
       194
       +
           ?date_modified:post.date

     

       195
       195
       +
           ?authors

     

       196
       196
       +
           ?tags

     

       197
       197
       +
           ()

     

       198
       198
       +
         in

     

       199
       199
       +
         let meta = {

     

       162
       200
        
           feed_url;

     

       163
       201
        
           feed_name;

     

       164
       202
        
           feed_title;

     

       165
       203
        
           stored_at = Ptime.of_float_s (Unix.gettimeofday ()) |> Option.get;

     

       166
       166
       -
           tags = post.tags;

     

       167
       167
       -
           summary = post.summary;

     

       168
       168
       -
         }

     

       204
       204
       +
         } in

     

       205
       205
       +
         { item; meta }

     

       169
       206
        
       

     

       170
       170
       -
       (* Convert Syndic.Atom.entry to stored_entry *)

     

       171
       171
       -
       let entry_of_atom ~feed_url ~feed_name ~feed_title (atom_entry : Syndic.Atom.entry) =

     

       207
       207
       +
       (* Convert Syndic.Atom.entry to Jsonfeed.Item.t *)

     

       208
       208
       +
       let item_of_atom ~feed_url ~feed_name ~feed_title (atom_entry : Syndic.Atom.entry) =

     

       172
       209
        
         let atom_id = Uri.to_string atom_entry.id in

     

       173
       173
       -
         let updated = atom_entry.updated in

     

       174
       174
       -
         let published = match atom_entry.published with

     

       210
       210
       +
         let date_modified = atom_entry.updated in

     

       211
       211
       +
         let date_published = match atom_entry.published with

     

       175
       212
        
           | Some p -> Some p

     

       176
       213
        
           | None -> Some atom_entry.updated

     

       177
       214
        
         in

     

       178
       178
       -
         (* Extract author info - Syndic doesn't expose person record fields,

     

       179
       179
       -
            so we'll use placeholders and reconstruct via Atom.author later *)

     

       180
       180
       -
         let content = match atom_entry.content with

     

       181
       181
       -
           | Some (Syndic.Atom.Text s) -> s

     

       182
       182
       -
           | Some (Syndic.Atom.Html (_, s)) -> s

     

       215
       215
       +
         (* Extract content *)

     

       216
       216
       +
         let content_html = match atom_entry.content with

     

       217
       217
       +
           | Some (Syndic.Atom.Text s) -> Some s

     

       218
       218
       +
           | Some (Syndic.Atom.Html (_, s)) -> Some s

     

       183
       219
        
           | Some (Syndic.Atom.Xhtml (_, nodes)) ->

     

       184
       220
        
               let ns_prefix _ = Some "" in

     

       185
       185
       -
               String.concat "" (List.map (Syndic.XML.to_string ~ns_prefix) nodes)

     

       186
       186
       -
           | Some (Syndic.Atom.Mime _) | Some (Syndic.Atom.Src _) | None ->

     

       187
       187
       -
               (match atom_entry.summary with

     

       188
       188
       -
               | Some (Syndic.Atom.Text s) -> s

     

       189
       189
       -
               | Some (Syndic.Atom.Html (_, s)) -> s

     

       190
       190
       -
               | Some (Syndic.Atom.Xhtml (_, nodes)) ->

     

       191
       191
       -
                   let ns_prefix _ = Some "" in

     

       192
       192
       -
                   String.concat "" (List.map (Syndic.XML.to_string ~ns_prefix) nodes)

     

       193
       193
       -
               | None -> "")

     

       221
       221
       +
               Some (String.concat "" (List.map (Syndic.XML.to_string ~ns_prefix) nodes))

     

       222
       222
       +
           | Some (Syndic.Atom.Mime _) | Some (Syndic.Atom.Src _) | None -> None

     

       223
       223
       +
         in

     

       224
       224
       +
         let content_text = match atom_entry.summary with

     

       225
       225
       +
           | Some s -> Some (Util.string_of_text_construct s)

     

       226
       226
       +
           | None -> None

     

       227
       227
       +
         in

     

       228
       228
       +
         let content = match content_html, content_text with

     

       229
       229
       +
           | Some h, Some t -> `Both (h, t)

     

       230
       230
       +
           | Some h, None -> `Html h

     

       231
       231
       +
           | None, Some t -> `Text t

     

       232
       232
       +
           | None, None -> `Text "" (* Fallback *)

     

       194
       233
        
         in

     

       195
       195
       -
         let link = try

     

       196
       196
       -
           Some (List.find (fun l -> l.Syndic.Atom.rel = Syndic.Atom.Alternate) atom_entry.links).href

     

       234
       234
       +
         let url = try

     

       235
       235
       +
           Some (Uri.to_string (List.find (fun l -> l.Syndic.Atom.rel = Syndic.Atom.Alternate) atom_entry.links).href)

     

       197
       236
        
         with Not_found ->

     

       198
       237
        
           match atom_entry.links with

     

       199
       199
       -
           | l :: _ -> Some l.href

     

       238
       238
       +
           | l :: _ -> Some (Uri.to_string l.href)

     

       200
       239
        
           | [] -> None

     

       201
       240
        
         in

     

       202
       202
       -
         (* Extract tags from categories *)

     

       203
       203
       -
         let tags = List.map (fun cat -> cat.Syndic.Atom.term) atom_entry.categories in

     

       204
       204
       -
         (* Extract summary *)

     

       241
       241
       +
         let tags =

     

       242
       242
       +
           let cat_tags = List.map (fun cat -> cat.Syndic.Atom.term) atom_entry.categories in

     

       243
       243
       +
           if cat_tags = [] then None else Some cat_tags

     

       244
       244
       +
         in

     

       205
       245
        
         let summary = match atom_entry.summary with

     

       206
       246
        
           | Some s -> Some (Util.string_of_text_construct s)

     

       207
       247
        
           | None -> None

     

       208
       248
        
         in

     

       209
       209
       -
         {

     

       210
       210
       -
           atom_id;

     

       211
       211
       -
           title = Util.string_of_text_construct atom_entry.title;

     

       212
       212
       -
           link;

     

       213
       213
       -
           published;

     

       214
       214
       -
           updated;

     

       215
       215
       -
           author_name = feed_name; (* Use feed name as fallback *)

     

       216
       216
       -
           author_email = None;

     

       217
       217
       -
           content;

     

       249
       249
       +
         let item = Jsonfeed.Item.create

     

       250
       250
       +
           ~id:atom_id

     

       251
       251
       +
           ~content

     

       252
       252
       +
           ?url

     

       253
       253
       +
           ~title:(Util.string_of_text_construct atom_entry.title)

     

       254
       254
       +
           ?summary

     

       255
       255
       +
           ?date_published

     

       256
       256
       +
           ~date_modified

     

       257
       257
       +
           ?tags

     

       258
       258
       +
           ()

     

       259
       259
       +
         in

     

       260
       260
       +
         let meta = {

     

       218
       261
        
           feed_url;

     

       219
       262
        
           feed_name;

     

       220
       263
        
           feed_title;

     

       221
       264
        
           stored_at = Ptime.of_float_s (Unix.gettimeofday ()) |> Option.get;

     

       222
       222
       -
           tags;

     

       223
       223
       -
           summary;

     

       224
       224
       -
         }

     

       265
       265
       +
         } in

     

       266
       266
       +
         { item; meta }

     

       225
       267
        
       

     

       226
       268
        
       (* Feed metadata management *)

     

       227
       269
        
       let update_feed_meta store ~feed_url ~feed_name ~feed_title ~sw:_ =

     
···

       233
       275
        
           last_updated = Ptime.of_float_s (Unix.gettimeofday ()) |> Option.get;

     

       234
       276
        
           entry_count = 0;

     

       235
       277
        
         } in

     

       236
       236
       -
         let json = feed_meta_to_json meta |> Yojson.Safe.to_string in

     

       237
       237
       -
         let source = Eio.Flow.string_source json in

     

       278
       278
       +
         let json_str = feed_meta_to_string meta in

     

       279
       279
       +
         let source = Eio.Flow.string_source json_str in

     

       238
       280
        
         Cacheio.put store.cache ~key ~source ~ttl:None ();

     

       239
       281
        
         Log.debug (fun m -> m "Updated feed metadata for %s" feed_url)

     

       240
       282
        
       

     
···

       245
       287
        
         | Some source ->

     

       246
       288
        
             try

     

       247
       289
        
               let json_str = Eio.Buf_read.(parse_exn take_all) source ~max_size:Int.max_int in

     

       248
       248
       -
               let json = Yojson.Safe.from_string json_str in

     

       249
       249
       -
               Some (feed_meta_of_json json)

     

       290
       290
       +
               Some (feed_meta_of_string json_str)

     

       250
       291
        
             with e ->

     

       251
       292
        
               Log.err (fun m -> m "Failed to parse feed metadata: %s" (Printexc.to_string e));

     

       252
       293
        
               None

     
···

       254
       295
        
       (* Entry storage *)

     

       255
       296
        
       

     

       256
       297
        
       let store_entry store ~feed_url ~feed_name ~feed_title ~post ~sw =

     

       257
       257
       -
         let entry = entry_of_post ~feed_url ~feed_name ~feed_title post in

     

       258
       258
       -
         let key = make_entry_key feed_url entry.atom_id in

     

       259
       259
       -
         let json = entry_to_json entry |> Yojson.Safe.to_string in

     

       260
       260
       -
         let source = Eio.Flow.string_source json in

     

       298
       298
       +
         let entry = item_of_post ~feed_url ~feed_name ~feed_title post in

     

       299
       299
       +
         let key = make_entry_key feed_url (Jsonfeed.Item.id entry.item) in

     

       300
       300
       +
         let json_str = entry_to_string entry in

     

       301
       301
       +
         let source = Eio.Flow.string_source json_str in

     

       261
       302
        
         Cacheio.put store.cache ~key ~source ~ttl:None ();

     

       262
       262
       -
         Log.debug (fun m -> m "Stored entry %s for feed %s" entry.atom_id feed_url);

     

       303
       303
       +
         Log.debug (fun m -> m "Stored entry %s for feed %s" (Jsonfeed.Item.id entry.item) feed_url);

     

       263
       304
        
         (* Update feed metadata *)

     

       264
       305
        
         update_feed_meta store ~feed_url ~feed_name ~feed_title ~sw

     

       265
       306
        
       

     
···

       273
       314
        
       let store_atom_entries store ~feed_url ~feed_name ~feed_title ~entries ~sw =

     

       274
       315
        
         Log.info (fun m -> m "Storing %d Atom entries for feed %s" (List.length entries) feed_url);

     

       275
       316
        
         List.iter (fun atom_entry ->

     

       276
       276
       -
           let entry = entry_of_atom ~feed_url ~feed_name ~feed_title atom_entry in

     

       277
       277
       -
           let key = make_entry_key feed_url entry.atom_id in

     

       278
       278
       -
           let json = entry_to_json entry |> Yojson.Safe.to_string in

     

       279
       279
       -
           let source = Eio.Flow.string_source json in

     

       317
       317
       +
           let entry = item_of_atom ~feed_url ~feed_name ~feed_title atom_entry in

     

       318
       318
       +
           let key = make_entry_key feed_url (Jsonfeed.Item.id entry.item) in

     

       319
       319
       +
           let json_str = entry_to_string entry in

     

       320
       320
       +
           let source = Eio.Flow.string_source json_str in

     

       280
       321
        
           Cacheio.put store.cache ~key ~source ~ttl:None ();

     

       281
       281
       -
           Log.debug (fun m -> m "Stored Atom entry %s" entry.atom_id);

     

       322
       322
       +
           Log.debug (fun m -> m "Stored Atom entry %s" (Jsonfeed.Item.id entry.item));

     

       282
       323
        
         ) entries;

     

       283
       324
        
         update_feed_meta store ~feed_url ~feed_name ~feed_title ~sw;

     

       284
       325
        
         Log.info (fun m -> m "Stored %d Atom entries for feed %s" (List.length entries) feed_url)

     
···

       292
       333
        
         | Some source ->

     

       293
       334
        
             try

     

       294
       335
        
               let json_str = Eio.Buf_read.(parse_exn take_all) source ~max_size:Int.max_int in

     

       295
       295
       -
               let json = Yojson.Safe.from_string json_str in

     

       296
       296
       -
               Some (entry_of_json json)

     

       336
       336
       +
               Some (entry_of_string json_str)

     

       297
       337
        
             with e ->

     

       298
       338
        
               Log.err (fun m -> m "Failed to parse entry: %s" (Printexc.to_string e));

     

       299
       339
        
               None

     
···

       311
       351
        
             | Some source ->

     

       312
       352
        
                 try

     

       313
       353
        
                   let json_str = Eio.Buf_read.(parse_exn take_all) source ~max_size:Int.max_int in

     

       314
       314
       -
                   let json = Yojson.Safe.from_string json_str in

     

       315
       315
       -
                   Some (entry_of_json json)

     

       354
       354
       +
                   Some (entry_of_string json_str)

     

       316
       355
        
                 with e ->

     

       317
       356
        
                   Log.err (fun m -> m "Failed to parse entry from scan: %s" (Printexc.to_string e));

     

       318
       357
        
                   None

     

       319
       358
        
           else None

     

       320
       359
        
         ) entries in

     

       321
       321
       -
         (* Sort by updated time, newest first *)

     

       322
       322
       -
         List.sort (fun a b -> Ptime.compare b.updated a.updated) feed_entries

     

       360
       360
       +
         (* Sort by date_modified, newest first *)

     

       361
       361
       +
         List.sort (fun a b ->

     

       362
       362
       +
           let time_a = Jsonfeed.Item.date_modified a.item |> Option.value ~default:a.meta.stored_at in

     

       363
       363
       +
           let time_b = Jsonfeed.Item.date_modified b.item |> Option.value ~default:b.meta.stored_at in

     

       364
       364
       +
           Ptime.compare time_b time_a

     

       365
       365
       +
         ) feed_entries

     

       323
       366
        
       

     

       324
       367
        
       let list_entries_filtered store ~feed_url ?since ?until ?limit ?(sort=`Updated) () =

     

       325
       368
        
         let entries = list_entries store ~feed_url in

     

       326
       369
        
         (* Filter by time *)

     

       327
       370
        
         let entries = match since with

     

       328
       371
        
           | None -> entries

     

       329
       329
       -
           | Some t -> List.filter (fun e -> Ptime.is_later e.updated ~than:t || Ptime.equal e.updated t) entries

     

       372
       372
       +
           | Some t -> List.filter (fun e ->

     

       373
       373
       +
               let time = Jsonfeed.Item.date_modified e.item |> Option.value ~default:e.meta.stored_at in

     

       374
       374
       +
               Ptime.is_later time ~than:t || Ptime.equal time t) entries

     

       330
       375
        
         in

     

       331
       376
        
         let entries = match until with

     

       332
       377
        
           | None -> entries

     

       333
       333
       -
           | Some t -> List.filter (fun e -> Ptime.is_earlier e.updated ~than:t || Ptime.equal e.updated t) entries

     

       378
       378
       +
           | Some t -> List.filter (fun e ->

     

       379
       379
       +
               let time = Jsonfeed.Item.date_modified e.item |> Option.value ~default:e.meta.stored_at in

     

       380
       380
       +
               Ptime.is_earlier time ~than:t || Ptime.equal time t) entries

     

       334
       381
        
         in

     

       335
       382
        
         (* Sort *)

     

       336
       383
        
         let entries = match sort with

     

       337
       384
        
           | `Published -> List.sort (fun a b ->

     

       338
       338
       -
               match a.published, b.published with

     

       339
       339
       -
               | Some pa, Some pb -> Ptime.compare pb pa

     

       385
       385
       +
               let pa = Jsonfeed.Item.date_published a.item in

     

       386
       386
       +
               let pb = Jsonfeed.Item.date_published b.item in

     

       387
       387
       +
               match pa, pb with

     

       388
       388
       +
               | Some ta, Some tb -> Ptime.compare tb ta

     

       340
       389
        
               | None, Some _ -> 1

     

       341
       390
        
               | Some _, None -> -1

     

       342
       342
       -
               | None, None -> Ptime.compare b.updated a.updated

     

       391
       391
       +
               | None, None ->

     

       392
       392
       +
                   let ta = Jsonfeed.Item.date_modified a.item |> Option.value ~default:a.meta.stored_at in

     

       393
       393
       +
                   let tb = Jsonfeed.Item.date_modified b.item |> Option.value ~default:b.meta.stored_at in

     

       394
       394
       +
                   Ptime.compare tb ta

     

       395
       395
       +
             ) entries

     

       396
       396
       +
           | `Updated -> List.sort (fun a b ->

     

       397
       397
       +
               let ta = Jsonfeed.Item.date_modified a.item |> Option.value ~default:a.meta.stored_at in

     

       398
       398
       +
               let tb = Jsonfeed.Item.date_modified b.item |> Option.value ~default:b.meta.stored_at in

     

       399
       399
       +
               Ptime.compare tb ta

     

       343
       400
        
             ) entries

     

       344
       344
       -
           | `Updated -> List.sort (fun a b -> Ptime.compare b.updated a.updated) entries

     

       345
       345
       -
           | `Stored -> List.sort (fun a b -> Ptime.compare b.stored_at a.stored_at) entries

     

       401
       401
       +
           | `Stored -> List.sort (fun a b -> Ptime.compare b.meta.stored_at a.meta.stored_at) entries

     

       346
       402
        
         in

     

       347
       403
        
         (* Limit *)

     

       348
       404
        
         match limit with

     
···

       365
       421
        
             | Some source ->

     

       366
       422
        
                 try

     

       367
       423
        
                   let json_str = Eio.Buf_read.(parse_exn take_all) source ~max_size:Int.max_int in

     

       368
       368
       -
                   let json = Yojson.Safe.from_string json_str in

     

       369
       369
       -
                   Some (entry_of_json json)

     

       424
       424
       +
                   Some (entry_of_string json_str)

     

       370
       425
        
                 with e ->

     

       371
       426
        
                   Log.err (fun m -> m "Failed to parse entry: %s" (Printexc.to_string e));

     

       372
       427
        
                   None

     

       373
       428
        
           else None

     

       374
       429
        
         ) entries in

     

       375
       375
       -
         let sorted = List.sort (fun a b -> Ptime.compare b.updated a.updated) all_entries in

     

       430
       430
       +
         let sorted = List.sort (fun a b ->

     

       431
       431
       +
           let ta = Jsonfeed.Item.date_modified a.item |> Option.value ~default:a.meta.stored_at in

     

       432
       432
       +
           let tb = Jsonfeed.Item.date_modified b.item |> Option.value ~default:b.meta.stored_at in

     

       433
       433
       +
           Ptime.compare tb ta

     

       434
       434
       +
         ) all_entries in

     

       376
       435
        
         List.filteri (fun i _ -> i < limit) sorted

     

       377
       436
        
       

     

       378
       437
        
       let find_entry_by_id store ~id =

     
···

       388
       447
        
             | Some source ->

     

       389
       448
        
                 (try

     

       390
       449
        
                   let json_str = Eio.Buf_read.(parse_exn take_all) source ~max_size:Int.max_int in

     

       391
       391
       -
                   let json = Yojson.Safe.from_string json_str in

     

       392
       392
       -
                   let entry = entry_of_json json in

     

       450
       450
       +
                   let entry = entry_of_string json_str in

     

       393
       451
        
                   (* Exact ID match only *)

     

       394
       394
       -
                   if entry.atom_id = id then

     

       452
       452
       +
                   if Jsonfeed.Item.id entry.item = id then

     

       395
       453
        
                     Some entry

     

       396
       454
        
                   else

     

       397
       455
        
                     None

     
···

       401
       459
        
           else None

     

       402
       460
        
         ) entries in

     

       403
       461
        
         (match matching_entry with

     

       404
       404
       -
          | Some e -> Log.debug (fun m -> m "Found entry: %s" e.title)

     

       462
       462
       +
          | Some e -> Log.debug (fun m -> m "Found entry: %s"

     

       463
       463
       +
                                   (Jsonfeed.Item.title e.item |> Option.value ~default:"(no title)"))

     

       405
       464
        
          | None -> Log.debug (fun m -> m "No entry found with ID: %s" id));

     

       406
       465
        
         matching_entry

     

       407
       466
        
       

     
···

       430
       489
        
         let entries = list_entries store ~feed_url in

     

       431
       490
        
         let to_delete = List.filteri (fun i _ -> i >= keep) entries in

     

       432
       491
        
         List.iter (fun entry ->

     

       433
       433
       -
           delete_entry store ~feed_url ~atom_id:entry.atom_id

     

       492
       492
       +
           delete_entry store ~feed_url ~atom_id:(Jsonfeed.Item.id entry.item)

     

       434
       493
        
         ) to_delete;

     

       435
       494
        
         let deleted = List.length to_delete in

     

       436
       495
        
         Log.info (fun m -> m "Pruned %d entries from feed %s (kept %d)" deleted feed_url keep);

     
···

       439
       498
        
       let prune_old_entries store ~feed_url ~older_than =

     

       440
       499
        
         let entries = list_entries store ~feed_url in

     

       441
       500
        
         let to_delete = List.filter (fun e ->

     

       442
       442
       -
           Ptime.is_earlier e.updated ~than:older_than

     

       501
       501
       +
           let time = Jsonfeed.Item.date_modified e.item |> Option.value ~default:e.meta.stored_at in

     

       502
       502
       +
           Ptime.is_earlier time ~than:older_than

     

       443
       503
        
         ) entries in

     

       444
       504
        
         List.iter (fun entry ->

     

       445
       445
       -
           delete_entry store ~feed_url ~atom_id:entry.atom_id

     

       505
       505
       +
           delete_entry store ~feed_url ~atom_id:(Jsonfeed.Item.id entry.item)

     

       446
       506
        
         ) to_delete;

     

       447
       507
        
         let deleted = List.length to_delete in

     

       448
       508
        
         Log.info (fun m -> m "Pruned %d old entries from feed %s" deleted feed_url);

     
···

       461
       521
        
             | Some source ->

     

       462
       522
        
                 try

     

       463
       523
        
                   let json_str = Eio.Buf_read.(parse_exn take_all) source ~max_size:Int.max_int in

     

       464
       464
       -
                   let json = Yojson.Safe.from_string json_str in

     

       465
       465
       -
                   Some (feed_meta_of_json json)

     

       524
       524
       +
                   Some (feed_meta_of_string json_str)

     

       466
       525
        
                 with e ->

     

       467
       526
        
                   Log.err (fun m -> m "Failed to parse feed metadata: %s" (Printexc.to_string e));

     

       468
       527
        
                   None

     
···

       502
       561
        
           | Some n -> list_entries_filtered store ~feed_url ~limit:n ()

     

       503
       562
        
         in

     

       504
       563
        
         let atom_entries = List.map (fun entry ->

     

       505
       505
       -
           let id = Uri.of_string entry.atom_id in

     

       506
       506
       -
           let entry_title : Syndic.Atom.text_construct = Syndic.Atom.Text entry.title in

     

       507
       507
       -
           let links = match entry.link with

     

       508
       508
       -
             | Some uri -> [Syndic.Atom.link ~rel:Syndic.Atom.Alternate uri]

     

       564
       564
       +
           let item = entry.item in

     

       565
       565
       +
           let id = Uri.of_string (Jsonfeed.Item.id item) in

     

       566
       566
       +
           let entry_title : Syndic.Atom.text_construct =

     

       567
       567
       +
             Syndic.Atom.Text (Jsonfeed.Item.title item |> Option.value ~default:"(no title)") in

     

       568
       568
       +
           let links = match Jsonfeed.Item.url item with

     

       569
       569
       +
             | Some url_str -> [Syndic.Atom.link ~rel:Syndic.Atom.Alternate (Uri.of_string url_str)]

     

       509
       570
        
             | None -> []

     

       510
       571
        
           in

     

       511
       511
       -
           let entry_content : Syndic.Atom.content = Syndic.Atom.Html (None, entry.content) in

     

       512
       512
       -
           let author = Syndic.Atom.author ?email:entry.author_email entry.author_name in

     

       572
       572
       +
           let content_str = match Jsonfeed.Item.content item with

     

       573
       573
       +
             | `Html h -> h

     

       574
       574
       +
             | `Text t -> t

     

       575
       575
       +
             | `Both (h, _) -> h

     

       576
       576
       +
           in

     

       577
       577
       +
           let entry_content : Syndic.Atom.content = Syndic.Atom.Html (None, content_str) in

     

       578
       578
       +
           let author_name = match Jsonfeed.Item.authors item with

     

       579
       579
       +
             | Some (a :: _) -> Jsonfeed.Author.name a |> Option.value ~default:entry.meta.feed_name

     

       580
       580
       +
             | _ -> entry.meta.feed_name

     

       581
       581
       +
           in

     

       582
       582
       +
           let author = Syndic.Atom.author author_name in

     

       513
       583
        
           let authors = (author, []) in

     

       514
       514
       -
           Syndic.Atom.entry ~id ~title:entry_title ~updated:entry.updated ?published:entry.published

     

       584
       584
       +
           let updated = Jsonfeed.Item.date_modified item |> Option.value ~default:entry.meta.stored_at in

     

       585
       585
       +
           Syndic.Atom.entry ~id ~title:entry_title ~updated

     

       586
       586
       +
             ?published:(Jsonfeed.Item.date_published item)

     

       515
       587
        
             ~links ~content:entry_content ~authors ()

     

       516
       588
        
         ) entries in

     

       517
       589
        
         let feed_title : Syndic.Atom.text_construct = match title with

     
···

       521
       593
        
         let feed_id = Uri.of_string ("urn:river:archive:" ^ (Digest.string feed_url |> Digest.to_hex)) in

     

       522
       594
        
         let feed_updated = match entries with

     

       523
       595
        
           | [] -> Ptime.of_float_s (Unix.gettimeofday ()) |> Option.get

     

       524
       524
       -
           | e :: _ -> e.updated

     

       596
       596
       +
           | e :: _ -> Jsonfeed.Item.date_modified e.item |> Option.value ~default:e.meta.stored_at

     

       525
       597
        
         in

     

       526
       598
        
         {

     

       527
       599
        
           Syndic.Atom.id = feed_id;

     
···

       551
       623
        
       (* Pretty printing *)

     

       552
       624
        
       

     

       553
       625
        
       let pp_entry fmt entry =

     

       626
       626
       +
         let item = entry.item in

     

       554
       627
        
         Format.fprintf fmt "@[<v 2>Entry:@,";

     

       555
       555
       -
         Format.fprintf fmt "ID: %s@," entry.atom_id;

     

       556
       556
       -
         Format.fprintf fmt "Title: %s@," entry.title;

     

       557
       557
       -
         Format.fprintf fmt "Link: %s@," (match entry.link with Some u -> Uri.to_string u | None -> "none");

     

       558
       558
       -
         Format.fprintf fmt "Published: %s@," (match entry.published with

     

       559
       559
       -
           | Some t -> Ptime.to_rfc3339 t

     

       560
       560
       -
           | None -> "unknown");

     

       561
       561
       -
         Format.fprintf fmt "Updated: %s@," (Ptime.to_rfc3339 entry.updated);

     

       562
       562
       -
         Format.fprintf fmt "Feed: %s (%s)@," entry.feed_name entry.feed_url;

     

       563
       563
       -
         Format.fprintf fmt "Stored: %s@]" (Ptime.to_rfc3339 entry.stored_at)

     

       628
       628
       +
         Format.fprintf fmt "ID: %s@," (Jsonfeed.Item.id item);

     

       629
       629
       +
         Format.fprintf fmt "Title: %s@," (Jsonfeed.Item.title item |> Option.value ~default:"(no title)");

     

       630
       630
       +
         Format.fprintf fmt "URL: %s@," (Jsonfeed.Item.url item |> Option.value ~default:"(none)");

     

       631
       631
       +
         (match Jsonfeed.Item.date_published item with

     

       632
       632
       +
          | Some t -> Format.fprintf fmt "Published: %s@," (Ptime.to_rfc3339 t)

     

       633
       633
       +
          | None -> ());

     

       634
       634
       +
         (match Jsonfeed.Item.date_modified item with

     

       635
       635
       +
          | Some t -> Format.fprintf fmt "Modified: %s@," (Ptime.to_rfc3339 t)

     

       636
       636
       +
          | None -> ());

     

       637
       637
       +
         Format.fprintf fmt "Feed: %s (%s)@," entry.meta.feed_name entry.meta.feed_url;

     

       638
       638
       +
         Format.fprintf fmt "Stored: %s@]" (Ptime.to_rfc3339 entry.meta.stored_at)

     

       564
       639
        
       

     

       565
       640
        
       let pp_feed_info fmt info =

     

       566
       641
        
         Format.fprintf fmt "@[<v 2>Feed:@,";

     
···

       578
       653
        
         List.iter (fun feed ->

     

       579
       654
        
           Format.fprintf fmt "  - %s: %d entries@," feed.name feed.entry_count

     

       580
       655
        
         ) feeds;

     

       581
       581
       -
         Format.fprintf fmt "@]"
     

       656
       656
       +
         Format.fprintf fmt "@]"

+13 -38

stack/river/lib/river_store.mli

···

       40
       40
        
       (** Abstract type representing the store *)

     

       41
       41
        
       type t

     

       42
       42
        
       

     

       43
       43
       -
       (** Stored entry with resolved URLs and metadata *)

     

       44
       44
       -
       type stored_entry = {

     

       45
       45
       -
         atom_id : string;

     

       46
       46
       -
         (** Unique Atom entry ID (used as key) *)

     

       43
       43
       +
       (** Stored entry - combines Jsonfeed.Item with storage metadata *)

     

       44
       44
       +
       type stored_entry

     

       47
       45
        
       

     

       48
       48
       -
         title : string;

     

       49
       49
       -
         (** Entry title *)

     

       46
       46
       +
       (** {2 Stored Entry Accessors} *)

     

       50
       47
        
       

     

       51
       51
       -
         link : Uri.t option;

     

       52
       52
       -
         (** Primary link (resolved against feed base URI) *)

     

       48
       48
       +
       val entry_item : stored_entry -> Jsonfeed.Item.t

     

       49
       49
       +
       (** Get the underlying Jsonfeed Item *)

     

       53
       50
        
       

     

       54
       54
       -
         published : Ptime.t option;

     

       55
       55
       -
         (** Publication date *)

     

       51
       51
       +
       val entry_feed_url : stored_entry -> string

     

       52
       52
       +
       (** Get the source feed URL *)

     

       56
       53
        
       

     

       57
       57
       -
         updated : Ptime.t;

     

       58
       58
       -
         (** Last update time *)

     

       54
       54
       +
       val entry_feed_name : stored_entry -> string

     

       55
       55
       +
       (** Get the source feed name *)

     

       59
       56
        
       

     

       60
       60
       -
         author_name : string;

     

       61
       61
       -
         (** Entry author name *)

     

       57
       57
       +
       val entry_feed_title : stored_entry -> string

     

       58
       58
       +
       (** Get the source feed title *)

     

       62
       59
        
       

     

       63
       63
       -
         author_email : string option;

     

       64
       64
       -
         (** Entry author email *)

     

       65
       65
       -
       

     

       66
       66
       -
         content : string;

     

       67
       67
       -
         (** HTML content with resolved URLs *)

     

       68
       68
       -
       

     

       69
       69
       -
         feed_url : string;

     

       70
       70
       -
         (** URL of the source feed *)

     

       71
       71
       -
       

     

       72
       72
       -
         feed_name : string;

     

       73
       73
       -
         (** Name of the source feed *)

     

       74
       74
       -
       

     

       75
       75
       -
         feed_title : string;

     

       76
       76
       -
         (** Title of the source feed *)

     

       77
       77
       -
       

     

       78
       78
       -
         stored_at : Ptime.t;

     

       79
       79
       -
         (** When this entry was stored *)

     

       80
       80
       -
       

     

       81
       81
       -
         tags : string list;

     

       82
       82
       -
         (** Tags associated with the entry *)

     

       83
       83
       -
       

     

       84
       84
       -
         summary : string option;

     

       85
       85
       -
         (** Summary/excerpt of the entry *)

     

       86
       86
       -
       }

     

       60
       60
       +
       val entry_stored_at : stored_entry -> Ptime.t

     

       61
       61
       +
       (** Get the storage timestamp *)

     

       87
       62
        
       

     

       88
       63
        
       (** Feed metadata *)

     

       89
       64
        
       type feed_info = {

+1 -2

stack/river/river.opam

···

       22
       22
        
         "lambdasoup"

     

       23
       23
        
         "uri"

     

       24
       24
        
         "cmdliner" {>= "2.0.0"}

     

       25
       25
       -
         "yojson"

     

       26
       25
        
         "fmt"

     

       27
       26
        
         "xdge"

     

       28
       27
        
         "jsonfeed" {>= "1.1.0"}

     

       29
       28
        
         "jsont" {>= "0.2.0"}

     

       30
       30
       -
         "bytesrw"

     

       29
       29
       +
         "jsont.bytesrw" {>= "0.2.0"}

     

       31
       30
        
         "odoc" {with-doc}

     

       32
       31
        
       ]

     

       33
       32
        
       build: [

+1 -1

stack/typesense-client/dune

···

       1
       1
        
       (library

     

       2
       2
        
        (public_name typesense-client)

     

       3
       3
        
        (name typesense_client)

     

       4
       4
       -
        (libraries eio requests requests_json_api ezjsonm fmt uri ptime))

     

       4
       4
       +
        (libraries eio requests requests_json_api jsont jsont.bytesrw fmt uri ptime))

+2 -1

stack/typesense-client/dune-project

···

       12
       12
        
         (ocaml (>= 4.14))

     

       13
       13
        
         eio

     

       14
       14
        
         requests

     

       15
       15
       -
         ezjsonm

     

       15
       15
       +
         jsont

     

       16
       16
       +
         jsont-bytesrw

     

       16
       17
        
         fmt

     

       17
       18
        
         uri

     

       18
       19
        
         ptime))

+2 -1

stack/typesense-client/typesense-client.opam

···

       8
       8
        
         "ocaml" {>= "4.14"}

     

       9
       9
        
         "eio"

     

       10
       10
        
         "requests"

     

       11
       11
       -
         "ezjsonm"

     

       11
       11
       +
         "jsont"

     

       12
       12
       +
         "jsont-bytesrw"

     

       12
       13
        
         "fmt"

     

       13
       14
        
         "uri"

     

       14
       15
        
         "ptime"

+175 -94

stack/typesense-client/typesense_client.ml

···

       53
       53
        
           Error (Connection_error (Printexc.to_string exn))

     

       54
       54
        
       

     

       55
       55
        
       (** Search result types *)

     

       56
       56
       +
       type highlight = {

     

       57
       57
       +
         field: string;

     

       58
       58
       +
         snippets: string list;

     

       59
       59
       +
       }

     

       60
       60
       +
       

     

       56
       61
        
       type search_result = {

     

       57
       62
        
         id: string;

     

       58
       63
        
         title: string;

     

       59
       64
        
         content: string;

     

       60
       65
        
         score: float;

     

       61
       66
        
         collection: string;

     

       62
       62
       -
         highlights: (string * string list) list;

     

       63
       63
       -
         document: Ezjsonm.value;  (* Store raw document for flexible field access *)

     

       67
       67
       +
         highlights: highlight list;

     

       68
       68
       +
         document: Jsont.json;  (* Store raw document for flexible field access *)

     

       64
       69
        
       }

     

       65
       70
        
       

     

       66
       71
        
       type search_response = {

     
···

       69
       74
        
         query_time: float;

     

       70
       75
        
       }

     

       71
       76
        
       

     

       72
       72
       -
       (** Parse search result from JSON *)

     

       73
       73
       -
       let parse_search_result collection json =

     

       74
       74
       -
         let open Ezjsonm in

     

       75
       75
       -
         let document = get_dict json |> List.assoc "document" in

     

       76
       76
       -
         let highlights = try get_dict json |> List.assoc "highlights" with _ -> `A [] in

     

       77
       77
       -
         let score = try get_dict json |> List.assoc "text_match" |> get_float with _ -> 0.0 in

     

       77
       77
       +
       (* Jsont codecs *)

     

       78
       78
        
       

     

       79
       79
       -
         let id = get_dict document |> List.assoc "id" |> get_string in

     

       80
       80
       -
         let title = try get_dict document |> List.assoc "title" |> get_string with _ -> "" in

     

       81
       81
       -
         let content = try

     

       79
       79
       +
       (** Helper to find a field by name in the fields list *)

     

       80
       80
       +
       let find_field field_name fields =

     

       81
       81
       +
         List.find_opt (fun ((name, _), _value) -> name = field_name) fields

     

       82
       82
       +
       

     

       83
       83
       +
       module Highlight = struct

     

       84
       84
       +
         let make field snippets = { field; snippets }

     

       85
       85
       +
         let field h = h.field

     

       86
       86
       +
         let snippets h = h.snippets

     

       87
       87
       +
       

     

       88
       88
       +
         let jsont =

     

       89
       89
       +
           Jsont.Object.map ~kind:"Highlight" make

     

       90
       90
       +
           |> Jsont.Object.mem "field" Jsont.string ~enc:field

     

       91
       91
       +
           |> Jsont.Object.mem "snippets" (Jsont.list Jsont.string) ~enc:snippets

     

       92
       92
       +
           |> Jsont.Object.finish

     

       93
       93
       +
       end

     

       94
       94
       +
       

     

       95
       95
       +
       module Search_result = struct

     

       96
       96
       +
         (* Helper to extract content from document based on collection *)

     

       97
       97
       +
         let extract_content collection document =

     

       98
       98
       +
           let get_string_field field_name =

     

       99
       99
       +
             match document with

     

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

     

       101
       101
       +
                 (match find_field field_name fields with

     

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

     

       103
       103
       +
                  | _ -> "")

     

       104
       104
       +
             | _ -> ""

     

       105
       105
       +
           in

     

       82
       106
        
           match collection with

     

       83
       83
       -
           | "papers" -> get_dict document |> List.assoc "abstract" |> get_string

     

       84
       84
       -
           | "projects" -> get_dict document |> List.assoc "description" |> get_string

     

       85
       85
       -
           | "news" -> get_dict document |> List.assoc "content" |> get_string

     

       86
       86
       -
           | "videos" -> get_dict document |> List.assoc "description" |> get_string

     

       87
       87
       -
           | "notes" -> get_dict document |> List.assoc "content" |> get_string

     

       88
       88
       -
           | "ideas" -> get_dict document |> List.assoc "description" |> get_string

     

       89
       89
       -
           | "contacts" -> get_dict document |> List.assoc "name" |> get_string

     

       107
       107
       +
           | "papers" -> get_string_field "abstract"

     

       108
       108
       +
           | "projects" -> get_string_field "description"

     

       109
       109
       +
           | "news" -> get_string_field "content"

     

       110
       110
       +
           | "videos" -> get_string_field "description"

     

       111
       111
       +
           | "notes" -> get_string_field "content"

     

       112
       112
       +
           | "ideas" -> get_string_field "description"

     

       113
       113
       +
           | "contacts" -> get_string_field "name"

     

       90
       114
        
           | _ -> ""

     

       91
       91
       -
         with _ -> "" in

     

       115
       115
       +
       

     

       116
       116
       +
         let make collection document highlights text_match =

     

       117
       117
       +
           let get_string_field field_name =

     

       118
       118
       +
             match document with

     

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

     

       120
       120
       +
                 (match find_field field_name fields with

     

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

     

       122
       122
       +
                  | _ -> "")

     

       123
       123
       +
             | _ -> ""

     

       124
       124
       +
           in

     

       125
       125
       +
           let id = get_string_field "id" in

     

       126
       126
       +
           let title = get_string_field "title" in

     

       127
       127
       +
           let content = extract_content collection document in

     

       128
       128
       +
           let score = Option.value text_match ~default:0.0 in

     

       129
       129
       +
           let highlights = Option.value highlights ~default:[] in

     

       130
       130
       +
           { id; title; content; score; collection; highlights; document }

     

       92
       131
        
       

     

       93
       93
       -
         let parse_highlights highlights =

     

       94
       94
       -
           try

     

       95
       95
       -
             get_list (fun h ->

     

       96
       96
       -
               let field = get_dict h |> List.assoc "field" |> get_string in

     

       97
       97
       -
               let snippets = get_dict h |> List.assoc "snippets" |> get_list get_string in

     

       98
       98
       -
               (field, snippets)

     

       99
       99
       -
             ) highlights

     

       100
       100
       -
           with _ -> []

     

       101
       101
       -
         in

     

       132
       132
       +
         let document r = r.document

     

       133
       133
       +
         let highlights r = if r.highlights = [] then None else Some r.highlights

     

       134
       134
       +
         let score r = if r.score = 0.0 then None else Some r.score

     

       135
       135
       +
       

     

       136
       136
       +
         let jsont collection =

     

       137
       137
       +
           Jsont.Object.map ~kind:"SearchResult" (make collection)

     

       138
       138
       +
           |> Jsont.Object.mem "document" Jsont.json ~enc:document

     

       139
       139
       +
           |> Jsont.Object.opt_mem "highlights" (Jsont.list Highlight.jsont) ~enc:highlights

     

       140
       140
       +
           |> Jsont.Object.opt_mem "text_match" Jsont.number ~enc:score

     

       141
       141
       +
           |> Jsont.Object.finish

     

       142
       142
       +
       end

     

       102
       143
        
       

     

       103
       103
       -
         { id; title; content; score; collection; highlights = parse_highlights highlights; document }

     

       144
       144
       +
       module Search_response = struct

     

       145
       145
       +
         let make hits found search_time_ms =

     

       146
       146
       +
           { hits; total = found; query_time = search_time_ms }

     

       147
       147
       +
       

     

       148
       148
       +
         let hits r = r.hits

     

       149
       149
       +
         let total r = r.total

     

       150
       150
       +
         let query_time r = r.query_time

     

       104
       151
        
       

     

       105
       105
       -
       (** Parse search response from JSON *)

     

       106
       106
       -
       let parse_search_response collection json =

     

       107
       107
       -
         let open Ezjsonm in

     

       108
       108
       -
         let hits = get_dict json |> List.assoc "hits" |> get_list (parse_search_result collection) in

     

       109
       109
       -
         let total = get_dict json |> List.assoc "found" |> get_int in

     

       110
       110
       -
         let query_time = get_dict json |> List.assoc "search_time_ms" |> get_float in

     

       111
       111
       -
         { hits; total; query_time }

     

       152
       152
       +
         let jsont collection =

     

       153
       153
       +
           Jsont.Object.map ~kind:"SearchResponse" make

     

       154
       154
       +
           |> Jsont.Object.mem "hits" (Jsont.list (Search_result.jsont collection)) ~enc:hits

     

       155
       155
       +
           |> Jsont.Object.mem "found" Jsont.int ~enc:total

     

       156
       156
       +
           |> Jsont.Object.mem "search_time_ms" Jsont.number ~enc:query_time

     

       157
       157
       +
           |> Jsont.Object.finish

     

       158
       158
       +
       end

     

       112
       159
        
       

     

       113
       160
        
       (** Search a single collection *)

     

       114
       161
        
       let search_collection client collection_name query ?(limit=10) ?(offset=0) () =

     
···

       128
       175
        
       

     

       129
       176
        
         match make_request client path with

     

       130
       177
        
         | Ok response_str ->

     

       131
       131
       -
             (match Requests_json_api.parse_json_result (parse_search_response collection_name) response_str with

     

       178
       178
       +
             (match Jsont_bytesrw.decode_string' (Search_response.jsont collection_name) response_str with

     

       132
       179
        
              | Ok search_response -> Ok search_response

     

       133
       133
       -
              | Error msg -> Error (Json_error msg))

     

       180
       180
       +
              | Error error -> Error (Json_error (Jsont.Error.to_string error)))

     

       134
       181
        
         | Error err -> Error err

     

       135
       182
        
       

     

       136
       183
        
       (** Helper function to drop n elements from list *)

     
···

       152
       199
        
         results: search_response list;

     

       153
       200
        
       }

     

       154
       201
        
       

     

       155
       155
       -
       (** Parse multisearch response from JSON *)

     

       156
       156
       -
       let parse_multisearch_response json =

     

       157
       157
       -
         let open Ezjsonm in

     

       158
       158
       -
         let results_json = get_dict json |> List.assoc "results" |> get_list (fun r -> r) in

     

       159
       159
       -
         let results = List.mapi (fun i result_json ->

     

       160
       160
       -
           let collection_name = match i with

     

       161
       161
       -
             | 0 -> "contacts"

     

       162
       162
       -
             | 1 -> "news"

     

       163
       163
       -
             | 2 -> "notes"

     

       164
       164
       -
             | 3 -> "papers"

     

       165
       165
       -
             | 4 -> "projects"

     

       166
       166
       -
             | 5 -> "ideas"

     

       167
       167
       -
             | 6 -> "videos"

     

       168
       168
       -
             | _ -> "unknown"

     

       169
       169
       -
           in

     

       170
       170
       -
           parse_search_response collection_name result_json

     

       171
       171
       -
         ) results_json in

     

       172
       172
       -
         { results }

     

       202
       202
       +
       (* Multisearch response decoder - needs special handling for collection names *)

     

       203
       203
       +
       let decode_multisearch_response collections json_str =

     

       204
       204
       +
         (* First decode as generic JSON *)

     

       205
       205
       +
         match Jsont_bytesrw.decode_string' Jsont.json json_str with

     

       206
       206
       +
         | Error e -> Error e

     

       207
       207
       +
         | Ok json ->

     

       208
       208
       +
             (* Extract the results array *)

     

       209
       209
       +
             match json with

     

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

     

       211
       211
       +
                 (match find_field "results" fields with

     

       212
       212
       +
                  | Some (_, Jsont.Array (results_array, _)) ->

     

       213
       213
       +
                      (* Decode each result with its corresponding collection name *)

     

       214
       214
       +
                      let decode_result idx result_json =

     

       215
       215
       +
                        let collection = List.nth collections idx in

     

       216
       216
       +
                        match Jsont_bytesrw.encode_string' ~format:Jsont.Minify Jsont.json result_json with

     

       217
       217
       +
                        | Error e -> Error e

     

       218
       218
       +
                        | Ok result_str ->

     

       219
       219
       +
                            Jsont_bytesrw.decode_string' (Search_response.jsont collection) result_str

     

       220
       220
       +
                      in

     

       221
       221
       +
                      let rec decode_all idx acc = function

     

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

     

       223
       223
       +
                        | hd :: tl ->

     

       224
       224
       +
                            match decode_result idx hd with

     

       225
       225
       +
                            | Error e -> Error e

     

       226
       226
       +
                            | Ok result -> decode_all (idx + 1) (result :: acc) tl

     

       227
       227
       +
                      in

     

       228
       228
       +
                      (match decode_all 0 [] results_array with

     

       229
       229
       +
                       | Ok results -> Ok { results }

     

       230
       230
       +
                       | Error e -> Error e)

     

       231
       231
       +
                  | _ -> Error (Jsont.Error.msg Jsont.Meta.none "Missing or invalid results field"))

     

       232
       232
       +
             | _ -> Error (Jsont.Error.msg Jsont.Meta.none "Expected JSON object")

     

       173
       233
        
       

     

       174
       234
        
       (** Perform multisearch across all collections *)

     

       175
       235
        
       let multisearch client query ?(limit=10) () =

     
···

       184
       244
        
           ("videos", "title,description,channel,platform,tags");

     

       185
       245
        
         ] in

     

       186
       246
        
       

     

       247
       247
       +
         (* Build search request objects *)

     

       187
       248
        
         let searches = List.map (fun collection ->

     

       188
       249
        
           let query_by = List.assoc collection query_by_collection in

     

       189
       189
       -
           Ezjsonm.dict [

     

       190
       190
       -
             ("collection", Ezjsonm.string collection);

     

       191
       191
       -
             ("q", Ezjsonm.string query);

     

       192
       192
       -
             ("query_by", Ezjsonm.string query_by);

     

       193
       193
       -
             ("exclude_fields", Ezjsonm.string "embedding");

     

       194
       194
       -
             ("per_page", Ezjsonm.int limit);

     

       195
       195
       -
           ]

     

       250
       250
       +
           Jsont.Object ([

     

       251
       251
       +
             (("collection", Jsont.Meta.none), Jsont.String (collection, Jsont.Meta.none));

     

       252
       252
       +
             (("q", Jsont.Meta.none), Jsont.String (query, Jsont.Meta.none));

     

       253
       253
       +
             (("query_by", Jsont.Meta.none), Jsont.String (query_by, Jsont.Meta.none));

     

       254
       254
       +
             (("exclude_fields", Jsont.Meta.none), Jsont.String ("embedding", Jsont.Meta.none));

     

       255
       255
       +
             (("per_page", Jsont.Meta.none), Jsont.Number (float_of_int limit, Jsont.Meta.none));

     

       256
       256
       +
           ], Jsont.Meta.none)

     

       196
       257
        
         ) collections in

     

       197
       258
        
       

     

       198
       198
       -
         let body = Ezjsonm.dict [("searches", Ezjsonm.list (fun x -> x) searches)] |> Ezjsonm.value_to_string in

     

       259
       259
       +
         let request_obj = Jsont.Object ([

     

       260
       260
       +
           (("searches", Jsont.Meta.none), Jsont.Array (searches, Jsont.Meta.none));

     

       261
       261
       +
         ], Jsont.Meta.none) in

     

       199
       262
        
       

     

       200
       200
       -
         match make_request client ~meth:`POST ~body "/multi_search" with

     

       201
       201
       -
         | Ok response_str ->

     

       202
       202
       -
             (match Requests_json_api.parse_json_result parse_multisearch_response response_str with

     

       203
       203
       -
              | Ok multisearch_resp -> Ok multisearch_resp

     

       204
       204
       -
              | Error msg -> Error (Json_error msg))

     

       205
       205
       -
         | Error err -> Error err

     

       263
       263
       +
         match Jsont_bytesrw.encode_string' ~format:Jsont.Minify Jsont.json request_obj with

     

       264
       264
       +
         | Error encode_error -> Error (Json_error (Jsont.Error.to_string encode_error))

     

       265
       265
       +
         | Ok body ->

     

       266
       266
       +
             match make_request client ~meth:`POST ~body "/multi_search" with

     

       267
       267
       +
             | Ok response_str ->

     

       268
       268
       +
                 (match decode_multisearch_response collections response_str with

     

       269
       269
       +
                  | Ok multisearch_resp -> Ok multisearch_resp

     

       270
       270
       +
                  | Error error -> Error (Json_error (Jsont.Error.to_string error)))

     

       271
       271
       +
             | Error err -> Error err

     

       206
       272
        
       

     

       207
       273
        
       (** Combine multisearch results into single result set *)

     

       208
       274
        
       let combine_multisearch_results (multisearch_resp : multisearch_response) ?(limit=10) ?(offset=0) () =

     
···

       226
       292
        
       

     

       227
       293
        
       (** List all collections *)

     

       228
       294
        
       let list_collections client =

     

       229
       229
       -
         let parse_collections json =

     

       230
       230
       -
           Ezjsonm.get_list (fun c ->

     

       231
       231
       -
             let name = Ezjsonm.get_dict c |> List.assoc "name" |> Ezjsonm.get_string in

     

       232
       232
       -
             let num_docs = Ezjsonm.get_dict c |> List.assoc "num_documents" |> Ezjsonm.get_int in

     

       233
       233
       -
             (name, num_docs)

     

       234
       234
       -
           ) json

     

       235
       235
       -
         in

     

       295
       295
       +
         let module Collection_info = struct

     

       296
       296
       +
           let make name num_documents = (name, num_documents)

     

       297
       297
       +
           let name ci = fst ci

     

       298
       298
       +
           let num_documents ci = snd ci

     

       299
       299
       +
       

     

       300
       300
       +
           let jsont =

     

       301
       301
       +
             Jsont.Object.map ~kind:"CollectionInfo" make

     

       302
       302
       +
             |> Jsont.Object.mem "name" Jsont.string ~enc:name

     

       303
       303
       +
             |> Jsont.Object.mem "num_documents" Jsont.int ~enc:num_documents

     

       304
       304
       +
             |> Jsont.Object.finish

     

       305
       305
       +
         end in

     

       306
       306
       +
       

     

       236
       307
        
         match make_request client "/collections" with

     

       237
       308
        
         | Ok response_str ->

     

       238
       238
       -
             (match Requests_json_api.parse_json_result parse_collections response_str with

     

       309
       309
       +
             (match Jsont_bytesrw.decode_string' (Jsont.list Collection_info.jsont) response_str with

     

       239
       310
        
              | Ok collections -> Ok collections

     

       240
       240
       -
              | Error msg -> Error (Json_error msg))

     

       311
       311
       +
              | Error error -> Error (Json_error (Jsont.Error.to_string error)))

     

       241
       312
        
         | Error err -> Error err

     

       242
       313
        
       

     

       243
       314
        
       (** Pretty printer utilities *)

     

       244
       315
        
       

     

       245
       316
        
       (** Extract field value from JSON document or return empty string if not found *)

     

       246
       246
       -
       let extract_field_string document field =

     

       247
       247
       -
         try

     

       248
       248
       -
           let open Ezjsonm in

     

       249
       249
       -
           get_dict document |> List.assoc field |> get_string

     

       250
       250
       -
         with _ -> ""

     

       317
       317
       +
       let extract_field_string document field_name =

     

       318
       318
       +
         match document with

     

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

     

       320
       320
       +
             (match find_field field_name fields with

     

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

     

       322
       322
       +
              | _ -> "")

     

       323
       323
       +
         | _ -> ""

     

       251
       324
        
       

     

       252
       325
        
       (** Extract field value from JSON document as string list or return empty list if not found *)

     

       253
       253
       -
       let extract_field_string_list document field =

     

       254
       254
       -
         try

     

       255
       255
       -
           let open Ezjsonm in

     

       256
       256
       -
           get_dict document |> List.assoc field |> get_list get_string

     

       257
       257
       -
         with _ -> []

     

       326
       326
       +
       let extract_field_string_list document field_name =

     

       327
       327
       +
         match document with

     

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

     

       329
       329
       +
             (match find_field field_name fields with

     

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

     

       331
       331
       +
                  List.filter_map (function

     

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

     

       333
       333
       +
                    | _ -> None

     

       334
       334
       +
                  ) items

     

       335
       335
       +
              | _ -> [])

     

       336
       336
       +
         | _ -> []

     

       258
       337
        
       

     

       259
       338
        
       (** Extract field value from JSON document as boolean or return false if not found *)

     

       260
       260
       -
       let extract_field_bool document field =

     

       261
       261
       -
         try

     

       262
       262
       -
           let open Ezjsonm in

     

       263
       263
       -
           get_dict document |> List.assoc field |> get_bool

     

       264
       264
       -
         with _ -> false

     

       339
       339
       +
       let extract_field_bool document field_name =

     

       340
       340
       +
         match document with

     

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

     

       342
       342
       +
             (match find_field field_name fields with

     

       343
       343
       +
              | Some (_, Jsont.Bool (b, _)) -> b

     

       344
       344
       +
              | _ -> false)

     

       345
       345
       +
         | _ -> false

     

       265
       346
        
       

     

       266
       347
        
       (** Format authors list for display *)

     

       267
       348
        
       let format_authors authors =

+12 -5

stack/typesense-client/typesense_client.mli

···

       27
       27
        
       val pp_error : Format.formatter -> error -> unit

     

       28
       28
        
       

     

       29
       29
        
       (** Search result types *)

     

       30
       30
       +
       

     

       31
       31
       +
       (** A highlight snippet from a search result *)

     

       32
       32
       +
       type highlight = {

     

       33
       33
       +
         field: string;

     

       34
       34
       +
         snippets: string list;

     

       35
       35
       +
       }

     

       36
       36
       +
       

     

       30
       37
        
       type search_result = {

     

       31
       38
        
         id: string;

     

       32
       39
        
         title: string;

     

       33
       40
        
         content: string;

     

       34
       41
        
         score: float;

     

       35
       42
        
         collection: string;

     

       36
       36
       -
         highlights: (string * string list) list;

     

       37
       37
       -
         document: Ezjsonm.value;  (* Store raw document for flexible field access *)

     

       43
       43
       +
         highlights: highlight list;

     

       44
       44
       +
         document: Jsont.json;  (* Store raw document for flexible field access *)

     

       38
       45
        
       }

     

       39
       46
        
       

     

       40
       47
        
       type search_response = {

     
···

       80
       87
        
         ((string * int) list, error) result

     

       81
       88
        
       

     

       82
       89
        
       (** Pretty printer utilities *)

     

       83
       83
       -
       val extract_field_string : Ezjsonm.value -> string -> string

     

       84
       84
       -
       val extract_field_string_list : Ezjsonm.value -> string -> string list

     

       85
       85
       -
       val extract_field_bool : Ezjsonm.value -> string -> bool

     

       90
       90
       +
       val extract_field_string : Jsont.json -> string -> string

     

       91
       91
       +
       val extract_field_string_list : Jsont.json -> string -> string list

     

       92
       92
       +
       val extract_field_bool : Jsont.json -> string -> bool

     

       86
       93
        
       val format_authors : string list -> string

     

       87
       94
        
       val format_date : string -> string

     

       88
       95
        
       val format_tags : string list -> string

+1 -1

stack/zotero-translation/dune

···

       1
       1
        
       (library

     

       2
       2
        
         (name zotero_translation)

     

       3
       3
        
         (public_name zotero-translation)

     

       4
       4
       -
         (libraries astring eio requests ezjsonm fpath uri))

     

       4
       4
       +
         (libraries astring eio requests jsont jsont.bytesrw fpath uri))

+2 -1

stack/zotero-translation/dune-project

···

       17
       17
        
         uri

     

       18
       18
        
         eio

     

       19
       19
        
         requests

     

       20
       20
       -
         ezjsonm

     

       20
       20
       +
         jsont

     

       21
       21
       +
         (jsont-bytesrw (>= "0.4"))

     

       21
       22
        
         yaml

     

       22
       23
        
         astring))

+2 -1

stack/zotero-translation/zotero-translation.opam

···

       13
       13
        
         "uri"

     

       14
       14
        
         "eio"

     

       15
       15
        
         "requests"

     

       16
       16
       -
         "ezjsonm"

     

       16
       16
       +
         "jsont"

     

       17
       17
       +
         "jsont-bytesrw" {>= "0.4"}

     

       17
       18
        
         "yaml"

     

       18
       19
        
         "astring"

     

       19
       20
        
         "odoc" {with-doc}

+105 -58

stack/zotero-translation/zotero_translation.ml

···

       1
       1
        
       (** Resolve a DOI from a Zotero translation server *)

     

       2
       2
        
       

     

       3
       3
       -
       module J = Ezjsonm

     

       4
       4
       -
       

     

       5
       3
        
       (* From the ZTS source code:  https://github.com/zotero/translation-server/blob/master/src/formats.js

     

       6
       4
        
         bibtex: "9cb70025-a888-4a29-a210-93ec52da40d4",

     

       7
       5
        
       	biblatex: "b6e39b57-8942-4d11-8259-342c46ce395f",

     
···

       104
       102
        
         requests_session: ('clock, 'net) Requests.t;

     

       105
       103
        
       }

     

       106
       104
        
       

     

       107
       107
       -
       let create ~sw ~env ?requests_session base_uri =

     

       108
       108
       -
         let requests_session = match requests_session with

     

       109
       109
       -
           | Some session -> session

     

       110
       110
       -
           | None -> Requests.create ~sw env

     

       111
       111
       -
         in

     

       105
       105
       +
       let create ~requests_session base_uri =

     

       112
       106
        
         { base_uri; requests_session }

     

       113
       113
       -
       

     

       114
       114
       -
       let v _base_uri =

     

       115
       115
       -
         failwith "Zotero_translation.v is deprecated. Use Zotero_translation.create ~sw ~env base_uri instead"

     

       116
       107
        
       

     

       117
       108
        
       let resolve_doi { base_uri; requests_session } doi =

     

       118
       109
        
         let body_str = "https://doi.org/" ^ doi in

     
···

       123
       114
        
         let body = Requests.Response.body response |> Eio.Flow.read_all in

     

       124
       115
        
         if status = 200 then begin

     

       125
       116
        
           try

     

       126
       126
       -
             let doi_json = J.from_string body in

     

       127
       127
       -
             Ok doi_json

     

       117
       117
       +
             match Jsont_bytesrw.decode_string' Jsont.json body with

     

       118
       118
       +
             | Ok doi_json -> Ok doi_json

     

       119
       119
       +
             | Error e -> Error (`Msg (Jsont.Error.to_string e))

     

       128
       120
        
           with exn -> Error (`Msg (Printexc.to_string exn))

     

       129
       121
        
         end else

     

       130
       122
        
           Error (`Msg (Format.asprintf "Unexpected HTTP status: %d for %s" status body))

     
···

       138
       130
        
         let body = Requests.Response.body response |> Eio.Flow.read_all in

     

       139
       131
        
         if status = 200 then begin

     

       140
       132
        
           try

     

       141
       141
       -
             let url_json = J.from_string body in

     

       142
       142
       -
             Ok url_json

     

       133
       133
       +
             match Jsont_bytesrw.decode_string' Jsont.json body with

     

       134
       134
       +
             | Ok url_json -> Ok url_json

     

       135
       135
       +
             | Error e -> Error (`Msg (Jsont.Error.to_string e))

     

       143
       136
        
           with exn -> Error (`Msg (Printexc.to_string exn))

     

       144
       137
        
         end else

     

       145
       138
        
           Error (`Msg (Format.asprintf "Unexpected HTTP status: %d for %s" status body))

     
···

       153
       146
        
         let body = Requests.Response.body response |> Eio.Flow.read_all in

     

       154
       147
        
         if status = 200 then begin

     

       155
       148
        
             try

     

       156
       156
       -
               let doi_json = J.from_string body in

     

       157
       157
       -
               Ok doi_json

     

       149
       149
       +
               match Jsont_bytesrw.decode_string' Jsont.json body with

     

       150
       150
       +
               | Ok doi_json -> Ok doi_json

     

       151
       151
       +
               | Error e -> Error (`Msg (Jsont.Error.to_string e))

     

       158
       152
        
             with exn -> Error (`Msg (Printexc.to_string exn))

     

       159
       153
        
         end else

     

       160
       154
        
           Error (`Msg (Format.asprintf "Unexpected HTTP status: %d for %s" status body))

     

       161
       155
        
       

     

       162
       156
        
       let export { base_uri; requests_session } format api =

     

       163
       163
       -
         let body_str = J.to_string api in

     

       164
       164
       -
         let uri = Uri.with_query' (export_endp base_uri ) ["format", (format_to_string format)] in

     

       165
       165
       -
         let body = Requests.Body.of_string Requests.Mime.json body_str in

     

       166
       166
       -
         let response = Requests.post requests_session ~body (Uri.to_string uri) in

     

       167
       167
       -
         let status = Requests.Response.status_code response in

     

       168
       168
       -
         let body = Requests.Response.body response |> Eio.Flow.read_all in

     

       169
       169
       -
         if status = 200 then begin

     

       170
       170
       -
           try

     

       171
       171
       -
             match format with

     

       172
       172
       -
             | Bibtex -> Ok (Astring.String.trim body)

     

       173
       173
       -
             | _ -> Ok body

     

       174
       174
       -
           with exn -> Error (`Msg (Printexc.to_string exn))

     

       175
       175
       -
         end else

     

       176
       176
       -
           Error (`Msg (Format.asprintf "Unexpected HTTP status: %d for %s" status body))

     

       157
       157
       +
         match Jsont_bytesrw.encode_string' Jsont.json api with

     

       158
       158
       +
         | Error e -> Error (`Msg (Jsont.Error.to_string e))

     

       159
       159
       +
         | Ok body_str ->

     

       160
       160
       +
             let uri = Uri.with_query' (export_endp base_uri ) ["format", (format_to_string format)] in

     

       161
       161
       +
             let body = Requests.Body.of_string Requests.Mime.json body_str in

     

       162
       162
       +
             let response = Requests.post requests_session ~body (Uri.to_string uri) in

     

       163
       163
       +
             let status = Requests.Response.status_code response in

     

       164
       164
       +
             let body = Requests.Response.body response |> Eio.Flow.read_all in

     

       165
       165
       +
             if status = 200 then begin

     

       166
       166
       +
               try

     

       167
       167
       +
                 match format with

     

       168
       168
       +
                 | Bibtex -> Ok (Astring.String.trim body)

     

       169
       169
       +
                 | _ -> Ok body

     

       170
       170
       +
               with exn -> Error (`Msg (Printexc.to_string exn))

     

       171
       171
       +
             end else

     

       172
       172
       +
               Error (`Msg (Format.asprintf "Unexpected HTTP status: %d for %s" status body))

     

       177
       173
        
       

     

       178
       174
        
       let unescape_hex s =

     

       179
       175
        
         let buf = Buffer.create (String.length s) in

     
···

       206
       202
        
         | Ok [bib] ->

     

       207
       203
        
             let f = Bibtex.fields bib |> Bibtex.SM.bindings |> List.map (fun (k,v) -> k, (unescape_bibtex v)) in

     

       208
       204
        
             let ty = match Bibtex.type' bib with "inbook" -> "book" | x -> x in

     

       209
       209
       -
             let v = List.fold_left (fun acc (k,v) -> (k,(`String v))::acc) ["bibtype",`String ty] f in

     

       205
       205
       +
             let v = List.fold_left (fun acc (k,v) -> ((k, Jsont.Meta.none), Jsont.String (v, Jsont.Meta.none))::acc)

     

       206
       206
       +
                 [(("bibtype", Jsont.Meta.none), Jsont.String (ty, Jsont.Meta.none))] f in

     

       210
       207
        
             v

     

       211
       208
        
         | Ok _ -> failwith "one bib at a time plz"

     

       212
       209
        
       

     

       213
       210
        
       let bib_of_doi zt doi =

     

       214
       211
        
         prerr_endline ("Fetching " ^ doi);

     

       215
       215
       -
         let v = match resolve_doi zt doi with

     

       216
       216
       -
         | Ok r -> r

     

       212
       212
       +
         match resolve_doi zt doi with

     

       217
       213
        
         | Error (`Msg _) ->

     

       218
       214
        
            Printf.eprintf "%s failed on /web, trying to /search\n%!" doi;

     

       219
       219
       -
            match search_id zt doi with

     

       215
       215
       +
            begin match search_id zt doi with

     

       220
       216
        
            | Error (`Msg e) -> failwith e

     

       221
       221
       -
            | Ok r -> r

     

       222
       222
       -
         in

     

       223
       223
       -
         match export zt Bibtex v with

     

       224
       224
       -
         | Error (`Msg e) -> failwith e

     

       225
       225
       -
         | Ok r ->

     

       226
       226
       -
             print_endline r;

     

       227
       227
       -
             r

     

       217
       217
       +
            | Ok v ->

     

       218
       218
       +
                match export zt Bibtex v with

     

       219
       219
       +
                | Error (`Msg e) -> failwith e

     

       220
       220
       +
                | Ok r ->

     

       221
       221
       +
                    print_endline r;

     

       222
       222
       +
                    r

     

       223
       223
       +
            end

     

       224
       224
       +
         | Ok v ->

     

       225
       225
       +
             match export zt Bibtex v with

     

       226
       226
       +
             | Error (`Msg e) -> failwith e

     

       227
       227
       +
             | Ok r ->

     

       228
       228
       +
                 print_endline r;

     

       229
       229
       +
                 r

     

       230
       230
       +
       

     

       231
       231
       +
       (* Helper to get string from Jsont.json *)

     

       232
       232
       +
       let get_string = function

     

       233
       233
       +
         | Jsont.String (s, _) -> s

     

       234
       234
       +
         | _ -> failwith "Expected string in JSON"

     

       235
       235
       +
       

     

       236
       236
       +
       (* Helper to get list from Jsont.json *)

     

       237
       237
       +
       let get_list f = function

     

       238
       238
       +
         | Jsont.Array (arr, _) -> List.map f arr

     

       239
       239
       +
         | _ -> failwith "Expected array in JSON"

     

       240
       240
       +
       

     

       241
       241
       +
       (* Helper to find a field in Jsont.Object *)

     

       242
       242
       +
       let find_field name = function

     

       243
       243
       +
         | Jsont.Object (mems, _) ->

     

       244
       244
       +
             List.find_map (fun ((k, _), v) -> if k = name then Some v else None) mems

     

       245
       245
       +
         | _ -> None

     

       246
       246
       +
       

     

       247
       247
       +
       (* Helper to get a required field as string *)

     

       248
       248
       +
       let get_field name json =

     

       249
       249
       +
         match find_field name json with

     

       250
       250
       +
         | Some v -> get_string v

     

       251
       251
       +
         | None -> failwith ("Missing field: " ^ name)

     

       252
       252
       +
       

     

       253
       253
       +
       (* Helper to update a field in a Jsont.Object *)

     

       254
       254
       +
       let update_field name value json =

     

       255
       255
       +
         match json with

     

       256
       256
       +
         | Jsont.Object (mems, meta) ->

     

       257
       257
       +
             let mems' =

     

       258
       258
       +
               match value with

     

       259
       259
       +
               | None -> List.filter (fun ((k, _), _) -> k <> name) mems

     

       260
       260
       +
               | Some v ->

     

       261
       261
       +
                   let without = List.filter (fun ((k, _), _) -> k <> name) mems in

     

       262
       262
       +
                   ((name, Jsont.Meta.none), v) :: without

     

       263
       263
       +
             in

     

       264
       264
       +
             Jsont.Object (mems', meta)

     

       265
       265
       +
         | _ -> json

     

       228
       266
        
       

     

       229
       267
        
       let split_authors keys =

     

       268
       268
       +
         let json = Jsont.Object (keys, Jsont.Meta.none) in

     

       269
       269
       +
         let author_str = get_field "author" json in

     

       230
       270
        
         let authors =

     

       231
       231
       -
           List.assoc "author" keys |> J.get_string |>

     

       232
       232
       -
           Astring.String.cuts ~empty:false ~sep:" and " |>

     

       271
       271
       +
           Astring.String.cuts ~empty:false ~sep:" and " author_str |>

     

       233
       272
        
           List.map Bibtex.list_value |>

     

       234
       273
        
           List.map (fun v -> List.rev v |> String.concat " ") |>

     

       235
       235
       -
           List.map (fun x -> `String x)

     

       274
       274
       +
           List.map (fun x -> Jsont.String (x, Jsont.Meta.none))

     

       236
       275
        
         in

     

       237
       276
        
         let keywords =

     

       238
       238
       -
           List.assoc_opt "keywords" keys |> function

     

       277
       277
       +
           match find_field "keywords" json with

     

       239
       278
        
           | None -> []

     

       240
       279
        
           | Some k ->

     

       241
       241
       -
               Astring.String.cuts ~empty:false ~sep:", " (J.get_string k) |>

     

       242
       242
       -
               List.map (fun x -> `String x)

     

       280
       280
       +
               Astring.String.cuts ~empty:false ~sep:", " (get_string k) |>

     

       281
       281
       +
               List.map (fun x -> Jsont.String (x, Jsont.Meta.none))

     

       243
       282
        
         in

     

       244
       244
       -
         J.update (`O keys) ["author"] (Some (`A authors)) |> fun j ->

     

       245
       245
       -
         J.update j ["keywords"] (match keywords with [] -> None | _ -> Some (`A keywords))

     

       283
       283
       +
         let json' = update_field "author" (Some (Jsont.Array (authors, Jsont.Meta.none))) json in

     

       284
       284
       +
         let json'' = update_field "keywords"

     

       285
       285
       +
           (match keywords with [] -> None | _ -> Some (Jsont.Array (keywords, Jsont.Meta.none))) json' in

     

       286
       286
       +
         match json'' with

     

       287
       287
       +
         | Jsont.Object (mems, _) -> mems

     

       288
       288
       +
         | _ -> failwith "Expected object"

     

       246
       289
        
       

     

       247
       290
        
       let add_bibtex ~slug y =

     

       248
       248
       -
         let (.%{}) = fun y k -> J.find y [k] in

     

       291
       291
       +
         let json = Jsont.Object (y, Jsont.Meta.none) in

     

       292
       292
       +
         let find_opt k = find_field k json in

     

       249
       293
        
         let add_if_present k f m =

     

       250
       250
       -
           match J.find y [k] with

     

       251
       251
       -
           | v -> Bibtex.SM.add k (f v) m

     

       252
       252
       -
           | exception Not_found -> m in

     

       253
       253
       -
         let string k m = add_if_present k J.get_string m in

     

       254
       254
       -
         let authors m = add_if_present "author" (fun j -> J.get_list J.get_string j |> String.concat " and ") m in

     

       294
       294
       +
           match find_opt k with

     

       295
       295
       +
           | Some v -> Bibtex.SM.add k (f v) m

     

       296
       296
       +
           | None -> m

     

       297
       297
       +
         in

     

       298
       298
       +
         let string k m = add_if_present k get_string m in

     

       299
       299
       +
         let authors m = add_if_present "author" (fun j -> get_list get_string j |> String.concat " and ") m in

     

       255
       300
        
         let cite_key = Astring.String.map (function '-' -> '_' |x -> x) slug in

     

       256
       301
        
         let fields = Bibtex.SM.empty in

     

       257
       257
       -
         let type' = y.%{"bibtype"} |> J.get_string |> String.lowercase_ascii in

     

       302
       302
       +
         let type' = get_field "bibtype" json |> String.lowercase_ascii in

     

       258
       303
        
         let fields = authors fields |> string "title" |> string "doi" |> string "month" |> string "year" |> string "url" in

     

       259
       304
        
         let fields = match type' with

     

       260
       305
        
           | "article" -> string "journal" fields |> string "volume" |> string "number" |> string "pages"

     
···

       264
       309
        
           | "misc" -> string "howpublished" fields

     

       265
       310
        
           | "techreport" -> string "institution" fields |> string "number" |> string "address"

     

       266
       311
        
           | b -> prerr_endline ("unknown bibtype " ^ b); fields in

     

       267
       267
       -
         Bibtex.v ~type' ~cite_key ~fields () |> Fmt.str "%a" Bibtex.pp |>

     

       268
       268
       -
         fun bib -> J.update y ["bib"] (Some (`String bib))

     

       312
       312
       +
         let bib = Bibtex.v ~type' ~cite_key ~fields () |> Fmt.str "%a" Bibtex.pp in

     

       313
       313
       +
         match update_field "bib" (Some (Jsont.String (bib, Jsont.Meta.none))) json with

     

       314
       314
       +
         | Jsont.Object (mems, _) -> mems

     

       315
       315
       +
         | _ -> failwith "Expected object"

     

       269
       316
        
       

     

       270
       317
        
       let json_of_doi zt ~slug doi =

     

       271
       318
        
         let x = bib_of_doi zt doi in

+8 -16

stack/zotero-translation/zotero_translation.mli

···

       25
       25
        
       val format_of_string: string -> format option

     

       26
       26
        
       

     

       27
       27
        
       (** Create a Zotero Translation client.

     

       28
       28
       -
           @param requests_session Optional Requests session for connection pooling.

     

       29
       29
       -
                                  If not provided, a new session is created. *)

     

       28
       28
       +
           @param requests_session Shared Requests session for connection pooling.

     

       29
       29
       +
           @param base_uri Base URI of the Zotero translation server (e.g., "http://localhost:1969"). *)

     

       30
       30
        
       val create :

     

       31
       31
       -
         sw:Eio.Switch.t ->

     

       32
       32
       -
         env:< clock: ([> float Eio.Time.clock_ty ] as 'clock) Eio.Resource.t;

     

       33
       33
       -
               net: ([> [> `Generic ] Eio.Net.ty ] as 'net) Eio.Resource.t;

     

       34
       34
       -
               fs: Eio.Fs.dir_ty Eio.Path.t; .. > ->

     

       35
       35
       -
         ?requests_session:('clock Eio.Resource.t, 'net Eio.Resource.t) Requests.t ->

     

       31
       31
       +
         requests_session:('clock Eio.Resource.t, 'net Eio.Resource.t) Requests.t ->

     

       36
       32
        
         string -> ('clock Eio.Resource.t, 'net Eio.Resource.t) t

     

       37
       33
        
       

     

       38
       38
       -
       (** Deprecated: use [create] instead *)

     

       39
       39
       -
       val v : string -> (_, _) t

     

       40
       40
       -
         [@@deprecated "Use create ~sw ~env base_uri instead"]

     

       41
       41
       -
       

     

       42
       34
        
       val resolve_doi: ([> float Eio.Time.clock_ty ] Eio.Resource.t, [> [> `Generic ] Eio.Net.ty ] Eio.Resource.t) t ->

     

       43
       43
       -
         string -> (Ezjsonm.t, [>`Msg of string]) result

     

       35
       35
       +
         string -> (Jsont.json, [>`Msg of string]) result

     

       44
       36
        
       

     

       45
       37
        
       val resolve_url: ([> float Eio.Time.clock_ty ] Eio.Resource.t, [> [> `Generic ] Eio.Net.ty ] Eio.Resource.t) t ->

     

       46
       46
       -
         string -> (Ezjsonm.t, [>`Msg of string]) result

     

       38
       38
       +
         string -> (Jsont.json, [>`Msg of string]) result

     

       47
       39
        
       

     

       48
       40
        
       val search_id: ([> float Eio.Time.clock_ty ] Eio.Resource.t, [> [> `Generic ] Eio.Net.ty ] Eio.Resource.t) t ->

     

       49
       49
       -
         string -> (Ezjsonm.t, [>`Msg of string]) result

     

       41
       41
       +
         string -> (Jsont.json, [>`Msg of string]) result

     

       50
       42
        
       

     

       51
       43
        
       val export: ([> float Eio.Time.clock_ty ] Eio.Resource.t, [> [> `Generic ] Eio.Net.ty ] Eio.Resource.t) t ->

     

       52
       52
       -
         format -> Ezjsonm.t -> (string, [>`Msg of string]) result

     

       44
       44
       +
         format -> Jsont.json -> (string, [>`Msg of string]) result

     

       53
       45
        
       

     

       54
       46
        
       val json_of_doi : ([> float Eio.Time.clock_ty ] Eio.Resource.t, [> [> `Generic ] Eio.Net.ty ] Eio.Resource.t) t ->

     

       55
       55
       -
         slug:string -> string -> Ezjsonm.value

     

       47
       47
       +
         slug:string -> string -> Jsont.object'

+217

stack/zulip/ARCHITECTURE.md

···

       1
       1
       +
       # Zulip Library Architecture

     

       2
       2
       +
       

     

       3
       3
       +
       ## Overview

     

       4
       4
       +
       

     

       5
       5
       +
       The Zulip OCaml library follows a clean, layered architecture that separates protocol types, encoding concerns, and HTTP communication.

     

       6
       6
       +
       

     

       7
       7
       +
       ## Architecture Layers

     

       8
       8
       +
       

     

       9
       9
       +
       ```

     

       10
       10
       +
       ┌─────────────────────────────────────┐

     

       11
       11
       +
       │   API Modules (Messages, Channels)  │  ← High-level operations

     

       12
       12
       +
       ├─────────────────────────────────────┤

     

       13
       13
       +
       │   Protocol Types (Message, Channel) │  ← Business logic types with Jsont codecs

     

       14
       14
       +
       ├─────────────────────────────────────┤

     

       15
       15
       +
       │   Encode Module                     │  ← JSON/Form encoding utilities

     

       16
       16
       +
       ├─────────────────────────────────────┤

     

       17
       17
       +
       │   Client Module                     │  ← HTTP request/response handling

     

       18
       18
       +
       ├─────────────────────────────────────┤

     

       19
       19
       +
       │   Requests Library (EIO-based)      │  ← Low-level HTTP

     

       20
       20
       +
       └─────────────────────────────────────┘

     

       21
       21
       +
       ```

     

       22
       22
       +
       

     

       23
       23
       +
       ## Key Design Principles

     

       24
       24
       +
       

     

       25
       25
       +
       ### 1. **Protocol Types with Jsont Codecs**

     

       26
       26
       +
       

     

       27
       27
       +
       Each Zulip API type (Message, Channel, User, etc.) has:

     

       28
       28
       +
       - A clean OCaml record type

     

       29
       29
       +
       - A `jsont` codec that defines bidirectional JSON conversion

     

       30
       30
       +
       - Accessor functions

     

       31
       31
       +
       - Pretty printer

     

       32
       32
       +
       

     

       33
       33
       +
       Example from `channel.ml`:

     

       34
       34
       +
       ```ocaml

     

       35
       35
       +
       type t = {

     

       36
       36
       +
         name : string;

     

       37
       37
       +
         description : string;

     

       38
       38
       +
         invite_only : bool;

     

       39
       39
       +
         history_public_to_subscribers : bool;

     

       40
       40
       +
       }

     

       41
       41
       +
       

     

       42
       42
       +
       let jsont =

     

       43
       43
       +
         Jsont.Object.map ~kind:"Channel" make

     

       44
       44
       +
         |> Jsont.Object.mem "name" Jsont.string ~enc:name

     

       45
       45
       +
         |> Jsont.Object.mem "description" Jsont.string ~enc:description

     

       46
       46
       +
         |> Jsont.Object.mem "invite_only" Jsont.bool ~enc:invite_only

     

       47
       47
       +
         |> Jsont.Object.mem "history_public_to_subscribers" Jsont.bool ~enc:history_public_to_subscribers

     

       48
       48
       +
         |> Jsont.Object.finish

     

       49
       49
       +
       ```

     

       50
       50
       +
       

     

       51
       51
       +
       ### 2. **Encode Module: Separation of Encoding Concerns**

     

       52
       52
       +
       

     

       53
       53
       +
       The `Encode` module provides clean utilities for converting between OCaml types and wire formats:

     

       54
       54
       +
       

     

       55
       55
       +
       ```ocaml

     

       56
       56
       +
       (** Convert using a jsont codec *)

     

       57
       57
       +
       val to_json_string : 'a Jsont.t -> 'a -> string

     

       58
       58
       +
       val to_form_urlencoded : 'a Jsont.t -> 'a -> string

     

       59
       59
       +
       val from_json : 'a Jsont.t -> Jsont.json -> ('a, string) result

     

       60
       60
       +
       ```

     

       61
       61
       +
       

     

       62
       62
       +
       This eliminates the need for:

     

       63
       63
       +
       - ❌ Manual JSON tree walking

     

       64
       64
       +
       - ❌ Round-trip encode→decode conversions

     

       65
       65
       +
       - ❌ Per-type encoding functions

     

       66
       66
       +
       

     

       67
       67
       +
       ### 3. **Request/Response Types with Codecs**

     

       68
       68
       +
       

     

       69
       69
       +
       API operations define request/response types locally with their codecs:

     

       70
       70
       +
       

     

       71
       71
       +
       ```ocaml

     

       72
       72
       +
       (* In channels.ml *)

     

       73
       73
       +
       module Subscribe_request = struct

     

       74
       74
       +
         type t = { subscriptions : string list }

     

       75
       75
       +
       

     

       76
       76
       +
         let codec =

     

       77
       77
       +
           Jsont.Object.(

     

       78
       78
       +
             map ~kind:"SubscribeRequest" (fun subscriptions -> { subscriptions })

     

       79
       79
       +
             |> mem "subscriptions" (Jsont.list Jsont.string) ~enc:(fun r -> r.subscriptions)

     

       80
       80
       +
             |> finish

     

       81
       81
       +
           )

     

       82
       82
       +
       end

     

       83
       83
       +
       

     

       84
       84
       +
       let subscribe client ~channels =

     

       85
       85
       +
         let req = Subscribe_request.{ subscriptions = channels } in

     

       86
       86
       +
         let body = Encode.to_form_urlencoded Subscribe_request.codec req in

     

       87
       87
       +
         let content_type = "application/x-www-form-urlencoded" in

     

       88
       88
       +
         match Client.request client ~method_:`POST ~path:"/api/v1/users/me/subscriptions"

     

       89
       89
       +
                 ~body ~content_type () with

     

       90
       90
       +
         | Ok _json -> Ok ()

     

       91
       91
       +
         | Error err -> Error err

     

       92
       92
       +
       ```

     

       93
       93
       +
       

     

       94
       94
       +
       ### 4. **Type-Safe Decoding**

     

       95
       95
       +
       

     

       96
       96
       +
       Response parsing uses codecs directly instead of manual pattern matching:

     

       97
       97
       +
       

     

       98
       98
       +
       ```ocaml

     

       99
       99
       +
       (* OLD - manual JSON walking *)

     

       100
       100
       +
       match json with

     

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

     

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

     

       103
       103
       +
           (match List.assoc_opt "streams" assoc with

     

       104
       104
       +
            | Some (Jsont.Array (channel_list, _)) -> ...

     

       105
       105
       +
       

     

       106
       106
       +
       (* NEW - type-safe codec *)

     

       107
       107
       +
       let response_codec =

     

       108
       108
       +
         Jsont.Object.(

     

       109
       109
       +
           map ~kind:"StreamsResponse" (fun streams -> streams)

     

       110
       110
       +
           |> mem "streams" (Jsont.list Channel.jsont) ~enc:(fun x -> x)

     

       111
       111
       +
           |> finish

     

       112
       112
       +
         )

     

       113
       113
       +
       in

     

       114
       114
       +
       match Encode.from_json response_codec json with

     

       115
       115
       +
       | Ok channels -> Ok channels

     

       116
       116
       +
       | Error msg -> Error (...)

     

       117
       117
       +
       ```

     

       118
       118
       +
       

     

       119
       119
       +
       ## Benefits

     

       120
       120
       +
       

     

       121
       121
       +
       ### ✅ Type Safety

     

       122
       122
       +
       - Jsont codecs ensure correct JSON structure

     

       123
       123
       +
       - Compilation errors catch schema mismatches

     

       124
       124
       +
       - No runtime type confusion

     

       125
       125
       +
       

     

       126
       126
       +
       ### ✅ Maintainability

     

       127
       127
       +
       - Protocol changes only require updating codecs

     

       128
       128
       +
       - No manual JSON manipulation scattered through code

     

       129
       129
       +
       - Clear separation of concerns

     

       130
       130
       +
       

     

       131
       131
       +
       ### ✅ Reusability

     

       132
       132
       +
       - Codecs can be composed and reused

     

       133
       133
       +
       - Encode module works for any jsont-encoded type

     

       134
       134
       +
       - Request/response types are self-documenting

     

       135
       135
       +
       

     

       136
       136
       +
       ### ✅ Testability

     

       137
       137
       +
       - Easy to test encoding/decoding in isolation

     

       138
       138
       +
       - Mock responses can be type-checked

     

       139
       139
       +
       - Round-trip property testing possible

     

       140
       140
       +
       

     

       141
       141
       +
       ## Migration Pattern

     

       142
       142
       +
       

     

       143
       143
       +
       When adding new API endpoints:

     

       144
       144
       +
       

     

       145
       145
       +
       1. **Define the protocol type with codec**:

     

       146
       146
       +
          ```ocaml

     

       147
       147
       +
          type my_request = { field1: string; field2: int }

     

       148
       148
       +
       

     

       149
       149
       +
          let my_request_codec =

     

       150
       150
       +
            Jsont.Object.(

     

       151
       151
       +
              map ~kind:"MyRequest" (fun field1 field2 -> { field1; field2 })

     

       152
       152
       +
              |> mem "field1" Jsont.string ~enc:(fun r -> r.field1)

     

       153
       153
       +
              |> mem "field2" Jsont.int ~enc:(fun r -> r.field2)

     

       154
       154
       +
              |> finish

     

       155
       155
       +
            )

     

       156
       156
       +
          ```

     

       157
       157
       +
       

     

       158
       158
       +
       2. **Encode using Encode module**:

     

       159
       159
       +
          ```ocaml

     

       160
       160
       +
          let body = Encode.to_form_urlencoded my_request_codec req in

     

       161
       161
       +
          (* or *)

     

       162
       162
       +
          let json = Encode.to_json_string my_request_codec req in

     

       163
       163
       +
          ```

     

       164
       164
       +
       

     

       165
       165
       +
       3. **Decode responses with codec**:

     

       166
       166
       +
          ```ocaml

     

       167
       167
       +
          match Client.request client ~method_:`POST ~path:"/api/..." ~body () with

     

       168
       168
       +
          | Ok json ->

     

       169
       169
       +
              (match Encode.from_json response_codec json with

     

       170
       170
       +
               | Ok data -> Ok data

     

       171
       171
       +
               | Error msg -> Error ...)

     

       172
       172
       +
          ```

     

       173
       173
       +
       

     

       174
       174
       +
       ## Comparison with Old Approach

     

       175
       175
       +
       

     

       176
       176
       +
       ### Old (Manual JSON Manipulation):

     

       177
       177
       +
       ```ocaml

     

       178
       178
       +
       let send client message =

     

       179
       179
       +
         let json = Message.to_json message in  (* Round-trip conversion *)

     

       180
       180
       +
         let params = match json with

     

       181
       181
       +
           | Jsont.Object (fields, _) ->  (* Manual pattern matching *)

     

       182
       182
       +
               List.fold_left (fun acc ((key, _), value) ->

     

       183
       183
       +
                 let str_value = match value with  (* More pattern matching *)

     

       184
       184
       +
                   | Jsont.String (s, _) -> s

     

       185
       185
       +
                   | Jsont.Bool (true, _) -> "true"

     

       186
       186
       +
                   | _ -> ""

     

       187
       187
       +
                 in

     

       188
       188
       +
                 (key, str_value) :: acc

     

       189
       189
       +
               ) [] fields

     

       190
       190
       +
           | _ -> [] in

     

       191
       191
       +
         (* ... *)

     

       192
       192
       +
       ```

     

       193
       193
       +
       

     

       194
       194
       +
       ### New (Codec-Based):

     

       195
       195
       +
       ```ocaml

     

       196
       196
       +
       let send client message =

     

       197
       197
       +
         let body = Message.to_form_urlencoded message in  (* Clean encoding *)

     

       198
       198
       +
         let content_type = "application/x-www-form-urlencoded" in

     

       199
       199
       +
         match Client.request client ~method_:`POST ~path:"/api/v1/messages"

     

       200
       200
       +
                 ~body ~content_type () with

     

       201
       201
       +
         | Ok response -> Message_response.of_json response

     

       202
       202
       +
         | Error err -> Error err

     

       203
       203
       +
       ```

     

       204
       204
       +
       

     

       205
       205
       +
       ## Future Enhancements

     

       206
       206
       +
       

     

       207
       207
       +
       - **Validation**: Add validation layers on top of codecs

     

       208
       208
       +
       - **Versioning**: Support multiple API versions with codec variants

     

       209
       209
       +
       - **Documentation**: Generate API docs from codec definitions

     

       210
       210
       +
       - **Testing**: Property-based testing with codec round-trips

     

       211
       211
       +
       - **Code Generation**: Consider generating codecs from OpenAPI specs

     

       212
       212
       +
       

     

       213
       213
       +
       ## References

     

       214
       214
       +
       

     

       215
       215
       +
       - Jsont library: https://erratique.ch/software/jsont

     

       216
       216
       +
       - Zulip REST API: https://zulip.com/api/rest

     

       217
       217
       +
       - Original design doc: `CLAUDE.md`

-689

stack/zulip/CLAUDE.md

···

       1
       1
       -
       I would like to build high quality OCaml bindings to the Zulip REST API,

     

       2
       2
       -
       documented at https://zulip.com/api/rest.  As another reference, the Python

     

       3
       3
       -
       `zulip` library from pip is well maintained.

     

       4
       4
       -
       

     

       5
       5
       -
       My target is to use the OCaml EIO direct-style library, with an idiomatic as

     

       6
       6
       -
       possible API that implements it. For JSON parsing, using the jsonm library is

     

       7
       7
       -
       right. For HTTPS, use cohttp-eio with the tls-eio library. You have access to

     

       8
       8
       -
       an OCaml LSP via MCP which provides type hints and other language server

     

       9
       9
       -
       features after you complete a `dune build`.

     

       10
       10
       -
       

     

       11
       11
       -
       # OCaml Zulip Library Design

     

       12
       12
       -
       

     

       13
       13
       -
       Based on analysis of:

     

       14
       14
       -
       - Zulip REST API documentation: https://zulip.com/api/rest

     

       15
       15
       -
       - Python zulip library: https://github.com/zulip/python-zulip-api

     

       16
       16
       -
       - Zulip error handling: https://zulip.com/api/rest-error-handling

     

       17
       17
       -
       - Zulip send message API: https://zulip.com/api/send-message

     

       18
       18
       -
       

     

       19
       19
       -
       ## Overview

     

       20
       20
       -
       The library follows OCaml best practices with abstract types (`type t`) per module, comprehensive constructors/accessors, and proper pretty printers. Each core concept gets its own module with a clean interface.

     

       21
       21
       -
       

     

       22
       22
       -
       ## Module Structure

     

       23
       23
       -
       

     

       24
       24
       -
       ### Authentication (`Zulip.Auth`)

     

       25
       25
       -
       ```ocaml

     

       26
       26
       -
       type t (* abstract *)

     

       27
       27
       -
       

     

       28
       28
       -
       val create : server_url:string -> email:string -> api_key:string -> t

     

       29
       29
       -
       val from_zuliprc : ?path:string -> unit -> (t, Error.t) result

     

       30
       30
       -
       val server_url : t -> string

     

       31
       31
       -
       val email : t -> string

     

       32
       32
       -
       val to_basic_auth_header : t -> string

     

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

     

       34
       34
       -
       ```

     

       35
       35
       -
       

     

       36
       36
       -
       ### Error Handling (`Zulip.Error`)

     

       37
       37
       -
       ```ocaml

     

       38
       38
       -
       type code = 

     

       39
       39
       -
         | Invalid_api_key

     

       40
       40
       -
         | Request_variable_missing

     

       41
       41
       -
         | Bad_request

     

       42
       42
       -
         | User_deactivated

     

       43
       43
       -
         | Realm_deactivated

     

       44
       44
       -
         | Rate_limit_hit

     

       45
       45
       -
         | Other of string

     

       46
       46
       -
       

     

       47
       47
       -
       type t (* abstract *)

     

       48
       48
       -
       

     

       49
       49
       -
       val create : code:code -> msg:string -> ?extra:(string * Jsonm.value) list -> unit -> t

     

       50
       50
       -
       val code : t -> code

     

       51
       51
       -
       val message : t -> string

     

       52
       52
       -
       val extra : t -> (string * Jsonm.value) list

     

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

     

       54
       54
       -
       val of_json : Jsonm.value -> t option

     

       55
       55
       -
       ```

     

       56
       56
       -
       

     

       57
       57
       -
       ### Message Types (`Zulip.Message_type`)

     

       58
       58
       -
       ```ocaml

     

       59
       59
       -
       type t = [ `Direct | `Channel ]

     

       60
       60
       -
       

     

       61
       61
       -
       val to_string : t -> string

     

       62
       62
       -
       val of_string : string -> t option

     

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

     

       64
       64
       -
       ```

     

       65
       65
       -
       

     

       66
       66
       -
       ### Message (`Zulip.Message`)

     

       67
       67
       -
       ```ocaml

     

       68
       68
       -
       type t (* abstract *)

     

       69
       69
       -
       

     

       70
       70
       -
       val create : 

     

       71
       71
       -
         type_:Message_type.t -> 

     

       72
       72
       -
         to_:string list -> 

     

       73
       73
       -
         content:string -> 

     

       74
       74
       -
         ?topic:string -> 

     

       75
       75
       -
         ?queue_id:string -> 

     

       76
       76
       -
         ?local_id:string -> 

     

       77
       77
       -
         ?read_by_sender:bool -> 

     

       78
       78
       -
         unit -> t

     

       79
       79
       -
       

     

       80
       80
       -
       val type_ : t -> Message_type.t

     

       81
       81
       -
       val to_ : t -> string list

     

       82
       82
       -
       val content : t -> string

     

       83
       83
       -
       val topic : t -> string option

     

       84
       84
       -
       val queue_id : t -> string option

     

       85
       85
       -
       val local_id : t -> string option

     

       86
       86
       -
       val read_by_sender : t -> bool

     

       87
       87
       -
       val to_json : t -> Jsonm.value

     

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

     

       89
       89
       -
       ```

     

       90
       90
       -
       

     

       91
       91
       -
       ### Message Response (`Zulip.Message_response`)

     

       92
       92
       -
       ```ocaml

     

       93
       93
       -
       type t (* abstract *)

     

       94
       94
       -
       

     

       95
       95
       -
       val id : t -> int

     

       96
       96
       -
       val automatic_new_visibility_policy : t -> string option

     

       97
       97
       -
       val of_json : Jsonm.value -> (t, Error.t) result

     

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

     

       99
       99
       -
       ```

     

       100
       100
       -
       

     

       101
       101
       -
       ### Client (`Zulip.Client`)

     

       102
       102
       -
       ```ocaml

     

       103
       103
       -
       type t (* abstract *)

     

       104
       104
       -
       

     

       105
       105
       -
       val create : #Eio.Env.t -> Auth.t -> t

     

       106
       106
       -
       val with_client : #Eio.Env.t -> Auth.t -> (t -> 'a) -> 'a

     

       107
       107
       -
       

     

       108
       108
       -
       val request : 

     

       109
       109
       -
         t -> 

     

       110
       110
       -
         method_:[`GET | `POST | `PUT | `DELETE | `PATCH] ->

     

       111
       111
       -
         path:string -> 

     

       112
       112
       -
         ?params:(string * string) list ->

     

       113
       113
       -
         ?body:string ->

     

       114
       114
       -
         unit -> 

     

       115
       115
       -
         (Jsonm.value, Error.t) result

     

       116
       116
       -
       ```

     

       117
       117
       -
       

     

       118
       118
       -
       ### Messages (`Zulip.Messages`)

     

       119
       119
       -
       ```ocaml

     

       120
       120
       -
       val send : Client.t -> Message.t -> (Message_response.t, Error.t) result

     

       121
       121
       -
       val edit : Client.t -> message_id:int -> ?content:string -> ?topic:string -> unit -> (unit, Error.t) result

     

       122
       122
       -
       val delete : Client.t -> message_id:int -> (unit, Error.t) result

     

       123
       123
       -
       val get : Client.t -> message_id:int -> (Jsonm.value, Error.t) result

     

       124
       124
       -
       val get_messages : 

     

       125
       125
       -
         Client.t -> 

     

       126
       126
       -
         ?anchor:string -> 

     

       127
       127
       -
         ?num_before:int -> 

     

       128
       128
       -
         ?num_after:int -> 

     

       129
       129
       -
         ?narrow:string list -> 

     

       130
       130
       -
         unit -> 

     

       131
       131
       -
         (Jsonm.value, Error.t) result

     

       132
       132
       -
       ```

     

       133
       133
       -
       

     

       134
       134
       -
       ### Channel (`Zulip.Channel`)

     

       135
       135
       -
       ```ocaml

     

       136
       136
       -
       type t (* abstract *)

     

       137
       137
       -
       

     

       138
       138
       -
       val create : 

     

       139
       139
       -
         name:string -> 

     

       140
       140
       -
         description:string -> 

     

       141
       141
       -
         ?invite_only:bool -> 

     

       142
       142
       -
         ?history_public_to_subscribers:bool -> 

     

       143
       143
       -
         unit -> t

     

       144
       144
       -
       

     

       145
       145
       -
       val name : t -> string

     

       146
       146
       -
       val description : t -> string

     

       147
       147
       -
       val invite_only : t -> bool

     

       148
       148
       -
       val history_public_to_subscribers : t -> bool

     

       149
       149
       -
       val to_json : t -> Jsonm.value

     

       150
       150
       -
       val of_json : Jsonm.value -> (t, Error.t) result

     

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

     

       152
       152
       -
       ```

     

       153
       153
       -
       

     

       154
       154
       -
       ### Channels (`Zulip.Channels`)

     

       155
       155
       -
       ```ocaml

     

       156
       156
       -
       val create_channel : Client.t -> Channel.t -> (unit, Error.t) result

     

       157
       157
       -
       val delete : Client.t -> name:string -> (unit, Error.t) result

     

       158
       158
       -
       val list : Client.t -> (Channel.t list, Error.t) result

     

       159
       159
       -
       val subscribe : Client.t -> channels:string list -> (unit, Error.t) result

     

       160
       160
       -
       val unsubscribe : Client.t -> channels:string list -> (unit, Error.t) result

     

       161
       161
       -
       ```

     

       162
       162
       -
       

     

       163
       163
       -
       ### User (`Zulip.User`)

     

       164
       164
       -
       ```ocaml

     

       165
       165
       -
       type t (* abstract *)

     

       166
       166
       -
       

     

       167
       167
       -
       val create : 

     

       168
       168
       -
         email:string -> 

     

       169
       169
       -
         full_name:string -> 

     

       170
       170
       -
         ?is_active:bool -> 

     

       171
       171
       -
         ?is_admin:bool -> 

     

       172
       172
       -
         ?is_bot:bool -> 

     

       173
       173
       -
         unit -> t

     

       174
       174
       -
       

     

       175
       175
       -
       val email : t -> string

     

       176
       176
       -
       val full_name : t -> string

     

       177
       177
       -
       val is_active : t -> bool

     

       178
       178
       -
       val is_admin : t -> bool

     

       179
       179
       -
       val is_bot : t -> bool

     

       180
       180
       -
       val to_json : t -> Jsonm.value

     

       181
       181
       -
       val of_json : Jsonm.value -> (t, Error.t) result

     

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

     

       183
       183
       -
       ```

     

       184
       184
       -
       

     

       185
       185
       -
       ### Users (`Zulip.Users`)

     

       186
       186
       -
       ```ocaml

     

       187
       187
       -
       val list : Client.t -> (User.t list, Error.t) result

     

       188
       188
       -
       val get : Client.t -> email:string -> (User.t, Error.t) result

     

       189
       189
       -
       val create_user : Client.t -> email:string -> full_name:string -> (unit, Error.t) result

     

       190
       190
       -
       val deactivate : Client.t -> email:string -> (unit, Error.t) result

     

       191
       191
       -
       ```

     

       192
       192
       -
       

     

       193
       193
       -
       ### Event Type (`Zulip.Event_type`)

     

       194
       194
       -
       ```ocaml

     

       195
       195
       -
       type t = 

     

       196
       196
       -
         | Message

     

       197
       197
       -
         | Subscription 

     

       198
       198
       -
         | User_activity

     

       199
       199
       -
         | Other of string

     

       200
       200
       -
       

     

       201
       201
       -
       val to_string : t -> string

     

       202
       202
       -
       val of_string : string -> t

     

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

     

       204
       204
       -
       ```

     

       205
       205
       -
       

     

       206
       206
       -
       ### Event (`Zulip.Event`)

     

       207
       207
       -
       ```ocaml

     

       208
       208
       -
       type t (* abstract *)

     

       209
       209
       -
       

     

       210
       210
       -
       val id : t -> int

     

       211
       211
       -
       val type_ : t -> Event_type.t

     

       212
       212
       -
       val data : t -> Jsonm.value

     

       213
       213
       -
       val of_json : Jsonm.value -> (t, Error.t) result

     

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

     

       215
       215
       -
       ```

     

       216
       216
       -
       

     

       217
       217
       -
       ### Event Queue (`Zulip.Event_queue`)

     

       218
       218
       -
       ```ocaml

     

       219
       219
       -
       type t (* abstract *)

     

       220
       220
       -
       

     

       221
       221
       -
       val register : 

     

       222
       222
       -
         Client.t -> 

     

       223
       223
       -
         ?event_types:Event_type.t list -> 

     

       224
       224
       -
         unit -> 

     

       225
       225
       -
         (t, Error.t) result

     

       226
       226
       -
       

     

       227
       227
       -
       val id : t -> string

     

       228
       228
       -
       val get_events : t -> Client.t -> ?last_event_id:int -> unit -> (Event.t list, Error.t) result

     

       229
       229
       -
       val delete : t -> Client.t -> (unit, Error.t) result

     

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

     

       231
       231
       -
       ```

     

       232
       232
       -
       

     

       233
       233
       -
       ## EIO Bot Framework Extension

     

       234
       234
       -
       

     

       235
       235
       -
       Based on analysis of the Python bot framework at:

     

       236
       236
       -
       - https://github.com/zulip/python-zulip-api/blob/main/zulip_bots/zulip_bots/lib.py

     

       237
       237
       -
       - https://github.com/zulip/python-zulip-api/blob/main/zulip_botserver/zulip_botserver/server.py

     

       238
       238
       -
       

     

       239
       239
       -
       ### Bot Handler (`Zulip.Bot`)

     

       240
       240
       -
       ```ocaml

     

       241
       241
       -
       module Storage : sig

     

       242
       242
       -
         type t (* abstract *)

     

       243
       243
       -
         

     

       244
       244
       -
         val create : Client.t -> t

     

       245
       245
       -
         val get : t -> key:string -> string option

     

       246
       246
       -
         val put : t -> key:string -> value:string -> unit

     

       247
       247
       -
         val contains : t -> key:string -> bool

     

       248
       248
       -
       end

     

       249
       249
       -
       

     

       250
       250
       -
       module Identity : sig

     

       251
       251
       -
         type t (* abstract *)

     

       252
       252
       -
         

     

       253
       253
       -
         val full_name : t -> string

     

       254
       254
       -
         val email : t -> string

     

       255
       255
       -
         val mention_name : t -> string

     

       256
       256
       -
       end

     

       257
       257
       -
       

     

       258
       258
       -
       type handler = {

     

       259
       259
       -
         handle_message : 

     

       260
       260
       -
           client:Client.t ->

     

       261
       261
       -
           message:Jsonm.value ->

     

       262
       262
       -
           response:(Message.t -> unit) ->

     

       263
       263
       -
           unit;

     

       264
       264
       -
         

     

       265
       265
       -
         usage : unit -> string;

     

       266
       266
       -
         description : unit -> string;

     

       267
       267
       -
       }

     

       268
       268
       -
       

     

       269
       269
       -
       type t (* abstract *)

     

       270
       270
       -
       

     

       271
       271
       -
       val create : 

     

       272
       272
       -
         Client.t -> 

     

       273
       273
       -
         handler:handler ->

     

       274
       274
       -
         ?storage:Storage.t ->

     

       275
       275
       -
         unit -> t

     

       276
       276
       -
       

     

       277
       277
       -
       val identity : t -> Identity.t

     

       278
       278
       -
       val storage : t -> Storage.t

     

       279
       279
       -
       val handle_message : t -> Jsonm.value -> unit

     

       280
       280
       -
       val send_reply : t -> original_message:Jsonm.value -> content:string -> unit

     

       281
       281
       -
       val send_message : t -> Message.t -> unit

     

       282
       282
       -
       ```

     

       283
       283
       -
       

     

       284
       284
       -
       ### Bot Server (`Zulip.Bot_server`)

     

       285
       285
       -
       ```ocaml

     

       286
       286
       -
       module Config : sig

     

       287
       287
       -
         type bot_config = {

     

       288
       288
       -
           email : string;

     

       289
       289
       -
           api_key : string;

     

       290
       290
       -
           token : string; (* webhook token *)

     

       291
       291
       -
           server_url : string;

     

       292
       292
       -
           module_name : string;

     

       293
       293
       -
         }

     

       294
       294
       -
         

     

       295
       295
       -
         type t (* abstract *)

     

       296
       296
       -
         

     

       297
       297
       -
         val create : bot_configs:bot_config list -> ?host:string -> ?port:int -> unit -> t

     

       298
       298
       -
         val from_file : string -> (t, Error.t) result

     

       299
       299
       -
         val from_env : string -> (t, Error.t) result

     

       300
       300
       -
         val host : t -> string

     

       301
       301
       -
         val port : t -> int

     

       302
       302
       -
         val bot_configs : t -> bot_config list

     

       303
       303
       -
       end

     

       304
       304
       -
       

     

       305
       305
       -
       type t (* abstract *)

     

       306
       306
       -
       

     

       307
       307
       -
       val create : #Eio.Env.t -> Config.t -> (t, Error.t) result

     

       308
       308
       -
       

     

       309
       309
       -
       val run : t -> unit

     

       310
       310
       -
       (* Starts the server using EIO structured concurrency *)

     

       311
       311
       -
       

     

       312
       312
       -
       val with_server : #Eio.Env.t -> Config.t -> (t -> 'a) -> ('a, Error.t) result

     

       313
       313
       -
       (* Resource-safe server management *)

     

       314
       314
       -
       ```

     

       315
       315
       -
       

     

       316
       316
       -
       ### Bot Registry (`Zulip.Bot_registry`)

     

       317
       317
       -
       ```ocaml

     

       318
       318
       -
       type bot_module = {

     

       319
       319
       -
         name : string;

     

       320
       320
       -
         handler : Bot.handler;

     

       321
       321
       -
         create_instance : Client.t -> Bot.t;

     

       322
       322
       -
       }

     

       323
       323
       -
       

     

       324
       324
       -
       type t (* abstract *)

     

       325
       325
       -
       

     

       326
       326
       -
       val create : unit -> t

     

       327
       327
       -
       val register : t -> bot_module -> unit

     

       328
       328
       -
       val get_handler : t -> email:string -> Bot.t option

     

       329
       329
       -
       val list_bots : t -> string list

     

       330
       330
       -
       

     

       331
       331
       -
       (* Dynamic module loading *)

     

       332
       332
       -
       val load_from_file : string -> (bot_module, Error.t) result

     

       333
       333
       -
       val load_from_directory : string -> (bot_module list, Error.t) result

     

       334
       334
       -
       ```

     

       335
       335
       -
       

     

       336
       336
       -
       ### Webhook Handler (`Zulip.Webhook`)

     

       337
       337
       -
       ```ocaml

     

       338
       338
       -
       type webhook_event = {

     

       339
       339
       -
         bot_email : string;

     

       340
       340
       -
         token : string;

     

       341
       341
       -
         message : Jsonm.value;

     

       342
       342
       -
         trigger : [`Direct_message | `Mention];

     

       343
       343
       -
       }

     

       344
       344
       -
       

     

       345
       345
       -
       type response = {

     

       346
       346
       -
         content : string option;

     

       347
       347
       -
         message_type : Message_type.t option;

     

       348
       348
       -
         to_ : string list option;

     

       349
       349
       -
         topic : string option;

     

       350
       350
       -
       }

     

       351
       351
       -
       

     

       352
       352
       -
       val parse_webhook : string -> (webhook_event, Error.t) result

     

       353
       353
       -
       val handle_webhook : Bot_registry.t -> webhook_event -> (response option, Error.t) result

     

       354
       354
       -
       ```

     

       355
       355
       -
       

     

       356
       356
       -
       ### Structured Concurrency Design

     

       357
       357
       -
       

     

       358
       358
       -
       The EIO-based server uses structured concurrency to manage multiple bots safely:

     

       359
       359
       -
       

     

       360
       360
       -
       ```ocaml

     

       361
       361
       -
       (* Example server implementation using EIO *)

     

       362
       362
       -
       let run_server env config =

     

       363
       363
       -
         let registry = Bot_registry.create () in

     

       364
       364
       -
         

     

       365
       365
       -
         (* Load and register all configured bots concurrently *)

     

       366
       366
       -
         Eio.Switch.run @@ fun sw ->

     

       367
       367
       -
         

     

       368
       368
       -
         (* Start each bot in its own fiber *)

     

       369
       369
       -
         List.iter (fun bot_config ->

     

       370
       370
       -
           Eio.Fiber.fork ~sw (fun () ->

     

       371
       371
       -
             let auth = Auth.create 

     

       372
       372
       -
               ~server_url:bot_config.server_url

     

       373
       373
       -
               ~email:bot_config.email 

     

       374
       374
       -
               ~api_key:bot_config.api_key in

     

       375
       375
       -
             

     

       376
       376
       -
             Client.with_client env auth @@ fun client ->

     

       377
       377
       -
             

     

       378
       378
       -
             (* Load bot module *)

     

       379
       379
       -
             match Bot_registry.load_from_file bot_config.module_name with

     

       380
       380
       -
             | Ok bot_module ->

     

       381
       381
       -
                 let bot = bot_module.create_instance client in

     

       382
       382
       -
                 Bot_registry.register registry bot_module;

     

       383
       383
       -
                 

     

       384
       384
       -
                 (* Keep bot alive and handle events *)

     

       385
       385
       -
                 Event_loop.run client bot

     

       386
       386
       -
             | Error e ->

     

       387
       387
       -
                 Printf.eprintf "Failed to load bot %s: %s\n" 

     

       388
       388
       -
                   bot_config.email (Error.message e)

     

       389
       389
       -
           )

     

       390
       390
       -
         ) (Config.bot_configs config);

     

       391
       391
       -
         

     

       392
       392
       -
         (* Start HTTP server for webhooks *)

     

       393
       393
       -
         let server_addr = `Tcp (Eio.Net.Ipaddr.V4.loopback, Config.port config) in

     

       394
       394
       -
         Eio.Net.run_server env#net server_addr ~on_error:raise @@ fun flow _addr ->

     

       395
       395
       -
           

     

       396
       396
       -
           (* Handle each webhook request concurrently *)

     

       397
       397
       -
           Eio.Switch.run @@ fun req_sw ->

     

       398
       398
       -
           Eio.Fiber.fork ~sw:req_sw (fun () ->

     

       399
       399
       -
             handle_http_request registry flow

     

       400
       400
       -
           )

     

       401
       401
       -
       ```

     

       402
       402
       -
       

     

       403
       403
       -
       ### Event Loop (`Zulip.Event_loop`)

     

       404
       404
       -
       ```ocaml

     

       405
       405
       -
       type t (* abstract *)

     

       406
       406
       -
       

     

       407
       407
       -
       val create : Client.t -> Bot.t -> t

     

       408
       408
       -
       

     

       409
       409
       -
       val run : Client.t -> Bot.t -> unit

     

       410
       410
       -
       (* Runs the event loop using real-time events API *)

     

       411
       411
       -
       

     

       412
       412
       -
       val run_webhook_mode : Client.t -> Bot.t -> unit  

     

       413
       413
       -
       (* Runs in webhook mode, waiting for HTTP callbacks *)

     

       414
       414
       -
       

     

       415
       415
       -
       (* For advanced use cases *)

     

       416
       416
       -
       val with_event_loop : 

     

       417
       417
       -
         Client.t -> 

     

       418
       418
       -
         Bot.t -> 

     

       419
       419
       -
         (Event_queue.t -> unit) -> 

     

       420
       420
       -
         unit

     

       421
       421
       -
       ```

     

       422
       422
       -
       

     

       423
       423
       -
       ## Key EIO Advantages

     

       424
       424
       -
       

     

       425
       425
       -
       1. **Structured Concurrency**: Each bot runs in its own fiber with proper cleanup

     

       426
       426
       -
       2. **Resource Safety**: Automatic cleanup of connections, event queues, and HTTP servers

     

       427
       427
       -
       3. **Backpressure**: Natural flow control through EIO's cooperative scheduling

     

       428
       428
       -
       4. **Error Isolation**: Bot failures don't crash the entire server

     

       429
       429
       -
       5. **Graceful Shutdown**: Structured teardown of all resources

     

       430
       430
       -
       

     

       431
       431
       -
       ## Design Principles

     

       432
       432
       -
       

     

       433
       433
       -
       1. **Abstract Types**: Each major concept has its own module with abstract `type t`

     

       434
       434
       -
       2. **Constructors**: Clear `create` functions with optional parameters

     

       435
       435
       -
       3. **Accessors**: All fields accessible via dedicated functions

     

       436
       436
       -
       4. **Pretty Printing**: Every type has a `pp` function for debugging

     

       437
       437
       -
       5. **JSON Conversion**: Bidirectional JSON conversion where appropriate

     

       438
       438
       -
       6. **Error Handling**: Consistent `(_, Error.t) result` return types

     

       439
       439
       -
       

     

       440
       440
       -
       ## Authentication Strategy

     

       441
       441
       -
       

     

       442
       442
       -
       - Support zuliprc files and direct credential passing

     

       443
       443
       -
       - Abstract `Auth.t` prevents credential leakage

     

       444
       444
       -
       - HTTP Basic Auth with proper encoding

     

       445
       445
       -
       

     

       446
       446
       -
       ## EIO Integration

     

       447
       447
       -
       

     

       448
       448
       -
       - All operations use EIO's direct-style async

     

       449
       449
       -
       - Resource-safe client management with `with_client`

     

       450
       450
       -
       - Proper cleanup of connections and event queues

     

       451
       451
       -
       

     

       452
       452
       -
       ## Example Usage

     

       453
       453
       -
       

     

       454
       454
       -
       ### Simple Message Sending

     

       455
       455
       -
       ```ocaml

     

       456
       456
       -
       let () =

     

       457
       457
       -
         Eio_main.run @@ fun env ->

     

       458
       458
       -
         let auth = Zulip.Auth.create 

     

       459
       459
       -
           ~server_url:"https://example.zulipchat.com"

     

       460
       460
       -
           ~email:"bot@example.com" 

     

       461
       461
       -
           ~api_key:"your-api-key" in

     

       462
       462
       -
         

     

       463
       463
       -
         Zulip.Client.with_client env auth @@ fun client ->

     

       464
       464
       -
         

     

       465
       465
       -
         let message = Zulip.Message.create 

     

       466
       466
       -
           ~type_:`Channel

     

       467
       467
       -
           ~to_:["general"]

     

       468
       468
       -
           ~content:"Hello from OCaml!"

     

       469
       469
       -
           ~topic:"Bots" 

     

       470
       470
       -
           () in

     

       471
       471
       -
         

     

       472
       472
       -
         match Zulip.Messages.send client message with

     

       473
       473
       -
         | Ok response -> 

     

       474
       474
       -
             Printf.printf "Message sent with ID: %d\n" 

     

       475
       475
       -
               (Zulip.Message_response.id response)

     

       476
       476
       -
         | Error error -> 

     

       477
       477
       -
             Printf.printf "Error: %s\n" 

     

       478
       478
       -
               (Zulip.Error.message error)

     

       479
       479
       -
       ```

     

       480
       480
       -
       

     

       481
       481
       -
       ### Simple Bot

     

       482
       482
       -
       ```ocaml

     

       483
       483
       -
       let echo_handler = Zulip.Bot.{

     

       484
       484
       -
         handle_message = (fun ~client ~message ~response ->

     

       485
       485
       -
           let content = extract_content message in

     

       486
       486
       -
           let echo_msg = Message.create 

     

       487
       487
       -
             ~type_:`Direct 

     

       488
       488
       -
             ~to_:[sender_email message]

     

       489
       489
       -
             ~content:("Echo: " ^ content) () in

     

       490
       490
       -
           response echo_msg

     

       491
       491
       -
         );

     

       492
       492
       -
         usage = (fun () -> "Echo bot - repeats your message");

     

       493
       493
       -
         description = (fun () -> "A simple echo bot");

     

       494
       494
       -
       }

     

       495
       495
       -
       

     

       496
       496
       -
       let () =

     

       497
       497
       -
         Eio_main.run @@ fun env ->

     

       498
       498
       -
         let auth = Auth.from_zuliprc () |> Result.get_ok in

     

       499
       499
       -
         

     

       500
       500
       -
         Client.with_client env auth @@ fun client ->

     

       501
       501
       -
         let bot = Bot.create client ~handler:echo_handler () in

     

       502
       502
       -
         Event_loop.run client bot

     

       503
       503
       -
       ```

     

       504
       504
       -
       

     

       505
       505
       -
       ### Multi-Bot Server

     

       506
       506
       -
       ```ocaml

     

       507
       507
       -
       let () =

     

       508
       508
       -
         Eio_main.run @@ fun env ->

     

       509
       509
       -
         let config = Bot_server.Config.from_file "bots.conf" |> Result.get_ok in

     

       510
       510
       -
         

     

       511
       511
       -
         Bot_server.with_server env config @@ fun server ->

     

       512
       512
       -
         Bot_server.run server

     

       513
       513
       -
       ```

     

       514
       514
       -
       

     

       515
       515
       -
       ## Package Dependencies

     

       516
       516
       -
       

     

       517
       517
       -
       - `eio` - Effects-based I/O

     

       518
       518
       -
       - `cohttp-eio` - HTTP client with EIO support  

     

       519
       519
       -
       - `tls-eio` - TLS support for HTTPS

     

       520
       520
       -
       - `jsonm` - Streaming JSON codec

     

       521
       521
       -
       - `uri` - URI parsing and manipulation

     

       522
       522
       -
       - `base64` - Base64 encoding for authentication

     

       523
       523
       -
       

     

       524
       524
       -
       # Architecture Analysis: zulip_bot vs zulip_botserver

     

       525
       525
       -
       

     

       526
       526
       -
       ## Library Separation

     

       527
       527
       -
       

     

       528
       528
       -
       ### `zulip_bot` - Individual Bot Framework

     

       529
       529
       -
       **Purpose**: Library for building and running a single bot instance

     

       530
       530
       -
       

     

       531
       531
       -
       **Key Components**:

     

       532
       532
       -
       - `Bot_handler` - Interface for bot logic with EIO environment access

     

       533
       533
       -
       - `Bot_runner` - Manages lifecycle of one bot (real-time events or webhook mode)

     

       534
       534
       -
       - `Bot_config` - Configuration for a single bot

     

       535
       535
       -
       - `Bot_storage` - Simple in-memory storage for bot state

     

       536
       536
       -
       

     

       537
       537
       -
       **Usage Pattern**:

     

       538
       538
       -
       ```ocaml

     

       539
       539
       -
       (* Run a single bot directly *)

     

       540
       540
       -
       let my_bot = Bot_handler.create (module My_echo_bot) ~config ~storage ~identity in

     

       541
       541
       -
       let runner = Bot_runner.create ~client ~handler:my_bot in

     

       542
       542
       -
       Bot_runner.run_realtime runner  (* Bot connects to Zulip events API directly *)

     

       543
       543
       -
       ```

     

       544
       544
       -
       

     

       545
       545
       -
       ### `zulip_botserver` - Multi-Bot Server Infrastructure  

     

       546
       546
       -
       **Purpose**: HTTP server that manages multiple bots via webhooks

     

       547
       547
       -
       

     

       548
       548
       -
       **Key Components**:

     

       549
       549
       -
       - `Bot_server` - HTTP server receiving webhook events from Zulip

     

       550
       550
       -
       - `Bot_registry` - Manages multiple bot instances  

     

       551
       551
       -
       - `Server_config` - Configuration for multiple bots + server settings

     

       552
       552
       -
       - `Webhook_handler` - Parses incoming webhook requests and routes to appropriate bots

     

       553
       553
       -
       

     

       554
       554
       -
       **Usage Pattern**:

     

       555
       555
       -
       ```ocaml

     

       556
       556
       -
       (* Run a server hosting multiple bots *)

     

       557
       557
       -
       let registry = Bot_registry.create () in

     

       558
       558
       -
       Bot_registry.register registry echo_bot_module;

     

       559
       559
       -
       Bot_registry.register registry weather_bot_module;

     

       560
       560
       -
       

     

       561
       561
       -
       let server = Bot_server.create ~env ~config ~registry in

     

       562
       562
       -
       Bot_server.run server  (* HTTP server waits for webhook calls *)

     

       563
       563
       -
       ```

     

       564
       564
       -
       

     

       565
       565
       -
       ## EIO Environment Requirements

     

       566
       566
       -
       

     

       567
       567
       -
       ### Why Bot Handlers Need Direct EIO Access

     

       568
       568
       -
       

     

       569
       569
       -
       Bot handlers require direct access to the EIO environment for legitimate I/O operations beyond HTTP requests to Zulip:

     

       570
       570
       -
       

     

       571
       571
       -
       1. **Network Operations**: Custom HTTP requests, API calls to external services

     

       572
       572
       -
       2. **File System Operations**: Reading configuration files, CSV dictionaries, logs

     

       573
       573
       -
       3. **Resource Management**: Proper cleanup via structured concurrency

     

       574
       574
       -
       

     

       575
       575
       -
       ### Example: URL Checker Bot

     

       576
       576
       -
       ```ocaml

     

       577
       577
       -
       module Url_checker_bot : Zulip_bot.Bot_handler.Bot_handler = struct

     

       578
       578
       -
         let handle_message ~config ~storage ~identity ~message ~env =

     

       579
       579
       -
           match parse_command message with

     

       580
       580
       -
           | "!check", url ->

     

       581
       581
       -
               (* Direct EIO network access needed *)

     

       582
       582
       -
               Eio.Switch.run @@ fun sw ->

     

       583
       583
       -
               let client = Cohttp_eio.Client.make ~sw env#net in

     

       584
       584
       -
               let response = Cohttp_eio.Client.head ~sw client (Uri.of_string url) in

     

       585
       585
       -
               let status = Cohttp.Code.code_of_status response.status in

     

       586
       586
       -
               Ok (Response.reply ~content:(format_status_message url status))

     

       587
       587
       -
           | _ -> Ok Response.none

     

       588
       588
       -
       end

     

       589
       589
       -
       ```

     

       590
       590
       -
       

     

       591
       591
       -
       ### Example: CSV Dictionary Bot

     

       592
       592
       -
       ```ocaml  

     

       593
       593
       -
       module Csv_dict_bot : Zulip_bot.Bot_handler.Bot_handler = struct

     

       594
       594
       -
         let handle_message ~config ~storage ~identity ~message ~env =

     

       595
       595
       -
           match parse_command message with

     

       596
       596
       -
           | "!lookup", term ->

     

       597
       597
       -
               (* Direct EIO file system access needed *)

     

       598
       598
       -
               let csv_path = Bot_config.get_required config ~key:"csv_file" in

     

       599
       599
       -
               let content = Eio.Path.load env#fs (Eio.Path.parse csv_path) in

     

       600
       600
       -
               let matches = search_csv_content content term in

     

       601
       601
       -
               Ok (Response.reply ~content:(format_matches matches))

     

       602
       602
       -
           | _ -> Ok Response.none

     

       603
       603
       -
       end

     

       604
       604
       -
       ```

     

       605
       605
       -
       

     

       606
       606
       -
       ## Refined Bot Handler Interface

     

       607
       607
       -
       

     

       608
       608
       -
       Based on analysis, the current EIO environment plumbing is **essential** and should be cleaned up:

     

       609
       609
       -
       

     

       610
       610
       -
       ```ocaml

     

       611
       611
       -
       (** Clean bot handler interface with direct EIO access *)

     

       612
       612
       -
       module type Bot_handler = sig

     

       613
       613
       -
         val initialize : Bot_config.t -> (unit, Zulip.Error.t) result

     

       614
       614
       -
         val usage : unit -> string

     

       615
       615
       -
         val description : unit -> string

     

       616
       616
       -
         

     

       617
       617
       -
         (** Handle message with full EIO environment access *)

     

       618
       618
       -
         val handle_message : 

     

       619
       619
       -
           config:Bot_config.t ->

     

       620
       620
       -
           storage:Bot_storage.t ->

     

       621
       621
       -
           identity:Identity.t ->

     

       622
       622
       -
           message:Message_context.t ->

     

       623
       623
       -
           env:#Eio.Env.t ->  (* Essential for custom I/O *)

     

       624
       624
       -
           (Response.t, Zulip.Error.t) result

     

       625
       625
       -
       end

     

       626
       626
       -
       

     

       627
       627
       -
       type t

     

       628
       628
       -
       

     

       629
       629
       -
       (** Single creation interface *)

     

       630
       630
       -
       val create : 

     

       631
       631
       -
         (module Bot_handler) -> 

     

       632
       632
       -
         config:Bot_config.t -> 

     

       633
       633
       -
         storage:Bot_storage.t -> 

     

       634
       634
       -
         identity:Identity.t -> 

     

       635
       635
       -
         t

     

       636
       636
       -
       

     

       637
       637
       -
       (** Single message handler requiring EIO environment *)

     

       638
       638
       -
       val handle_message : t -> #Eio.Env.t -> Message_context.t -> (Response.t, Zulip.Error.t) result

     

       639
       639
       -
       ```

     

       640
       640
       -
       

     

       641
       641
       -
       ## Storage Strategy

     

       642
       642
       -
       

     

       643
       643
       -
       Bot storage can be simplified to in-memory key-value storage since it's server-side:

     

       644
       644
       -
       

     

       645
       645
       -
       ```ocaml

     

       646
       646
       -
       (* In zulip_bot - storage per bot instance *)

     

       647
       647
       -
       module Bot_storage = struct

     

       648
       648
       -
         type t = (string, string) Hashtbl.t  (* Simple in-memory key-value *)

     

       649
       649
       -
         

     

       650
       650
       -
         let create () = Hashtbl.create 16

     

       651
       651
       -
         let get t ~key = Hashtbl.find_opt t key  

     

       652
       652
       -
         let put t ~key ~value = Hashtbl.replace t key value

     

       653
       653
       -
         let contains t ~key = Hashtbl.mem t key

     

       654
       654
       -
       end

     

       655
       655
       -
       

     

       656
       656
       -
       (* In zulip_botserver - storage shared across bots *)

     

       657
       657
       -
       module Server_storage = struct

     

       658
       658
       -
         type t = (string * string, string) Hashtbl.t  (* (bot_email, key) -> value *)

     

       659
       659
       -
         

     

       660
       660
       -
         let create () = Hashtbl.create 64

     

       661
       661
       -
         let get t ~bot_email ~key = Hashtbl.find_opt t (bot_email, key)

     

       662
       662
       -
         let put t ~bot_email ~key ~value = Hashtbl.replace t (bot_email, key) value

     

       663
       663
       -
       end

     

       664
       664
       -
       ```

     

       665
       665
       -
       

     

       666
       666
       -
       ## Interface Cleanup Recommendations

     

       667
       667
       -
       

     

       668
       668
       -
       1. **Remove** the problematic `handle_message` function with mock environment

     

       669
       669
       -
       2. **Keep** `handle_message_with_env` but rename to `handle_message`

     

       670
       670
       -
       3. **Use** `#Eio.Env.t` constraint for clean typing

     

       671
       671
       -
       4. **Document** that bot handlers have full EIO access for custom I/O operations

     

       672
       672
       -
       

     

       673
       673
       -
       This design maintains flexibility for real-world bot functionality while providing clean, type-safe interfaces.

     

       674
       674
       -
       

     

       675
       675
       -
       ## Sources and References

     

       676
       676
       -
       

     

       677
       677
       -
       This design is based on comprehensive analysis of:

     

       678
       678
       -
       

     

       679
       679
       -
       1. **Zulip REST API Documentation**:

     

       680
       680
       -
          - Main API: https://zulip.com/api/rest

     

       681
       681
       -
          - Error Handling: https://zulip.com/api/rest-error-handling  

     

       682
       682
       -
          - Send Message: https://zulip.com/api/send-message

     

       683
       683
       -
       

     

       684
       684
       -
       2. **Python Zulip Library**:

     

       685
       685
       -
          - Main repository: https://github.com/zulip/python-zulip-api

     

       686
       686
       -
          - Bot framework: https://github.com/zulip/python-zulip-api/blob/main/zulip_bots/zulip_bots/lib.py

     

       687
       687
       -
          - Bot server: https://github.com/zulip/python-zulip-api/blob/main/zulip_botserver/zulip_botserver/server.py

     

       688
       688
       -
       

     

       689
       689
       -
       The design adapts these Python patterns to idiomatic OCaml with abstract types, proper error handling, and EIO's structured concurrency for robust, type-safe Zulip integration.

+2 -2

stack/zulip/dune-project

···

       2
       2
        
       

     

       3
       3
        
       (name ocaml-zulip)

     

       4
       4
        
       

     

       5
       5
       +
       (generate_opam_files true)

     

       6
       6
       +
       

     

       5
       7
        
       (package

     

       6
       8
        
        (name zulip)

     

       7
       9
        
        (synopsis "OCaml bindings for the Zulip REST API")

     
···

       11
       13
        
         dune

     

       12
       14
        
         eio

     

       13
       15
        
         requests

     

       14
       14
       -
         ezjsonm

     

       15
       16
        
         uri

     

       16
       17
        
         base64

     

       17
       18
        
         (alcotest :with-test)

     
···

       26
       27
        
         dune

     

       27
       28
        
         zulip

     

       28
       29
        
         eio

     

       29
       29
       -
         ezjsonm

     

       30
       30
        
         (alcotest :with-test)))

     

       31
       31
        
       

     

       32
       32
        
       (package

+2 -5

stack/zulip/examples/example.ml

···

       31
       31
        
           (match Message.topic message with Some t -> t | None -> "None");

     

       32
       32
        
       

     

       33
       33
        
         (* Test JSON serialization *)

     

       34
       34
       -
         let json = Message.to_json message in

     

       35
       35
       -
         Printf.printf "\nMessage JSON: %s\n"

     

       36
       36
       -
           (match json with

     

       37
       37
       -
            | `O _ -> "JSON object (serialized correctly)"

     

       38
       38
       -
            | _ -> "Invalid JSON");

     

       34
       34
       +
         let json_str = Message.to_json_string message in

     

       35
       35
       +
         Printf.printf "\nMessage JSON: %s\n" json_str;

     

       39
       36
        
       

     

       40
       37
        
         (* Create client *)

     

       41
       38
        
         let client = Client.create ~sw env auth in

+4 -3

stack/zulip/examples/test_client.ml

···

       48
       48
        
         | Ok json ->

     

       49
       49
        
             Printf.printf "Fetched messages successfully!\n";

     

       50
       50
        
             (match json with

     

       51
       51
       -
              | `O fields ->

     

       52
       52
       -
                  (match List.assoc_opt "messages" fields with

     

       53
       53
       -
                   | Some (`A messages) ->

     

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

     

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

     

       53
       53
       +
                  (match List.assoc_opt "messages" assoc with

     

       54
       54
       +
                   | Some (Jsont.Array (messages, _)) ->

     

       54
       55
        
                       Printf.printf "Got %d messages\n" (List.length messages)

     

       55
       56
        
                   | _ -> Printf.printf "No messages field found\n")

     

       56
       57
        
              | _ -> Printf.printf "Unexpected JSON format\n")

+25 -33

stack/zulip/lib/zulip/lib/channel.ml

···

       13
       13
        
       let invite_only t = t.invite_only

     

       14
       14
        
       let history_public_to_subscribers t = t.history_public_to_subscribers

     

       15
       15
        
       

     

       16
       16
       -
       let to_json t = 

     

       17
       17
       -
         `O [

     

       18
       18
       -
           ("name", `String t.name);

     

       19
       19
       -
           ("description", `String t.description);

     

       20
       20
       -
           ("invite_only", `Bool t.invite_only);

     

       21
       21
       -
           ("history_public_to_subscribers", `Bool t.history_public_to_subscribers);

     

       22
       22
       -
         ]

     

       16
       16
       +
       let pp fmt t = Format.fprintf fmt "Channel{name=%s, description=%s}" t.name t.description

     

       23
       17
        
       

     

       24
       24
       -
       let of_json json = 

     

       25
       25
       -
         try

     

       26
       26
       -
           match json with

     

       27
       27
       -
           | `O fields ->

     

       28
       28
       -
               let get_string key = 

     

       29
       29
       -
                 match List.assoc key fields with 

     

       30
       30
       -
                 | `String s -> s 

     

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

     

       32
       32
       -
               let get_bool key default = 

     

       33
       33
       -
                 match List.assoc_opt key fields with 

     

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

     

       35
       35
       -
                 | None -> default

     

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

     

       37
       37
       -
               

     

       38
       38
       -
               let name = get_string "name" in

     

       39
       39
       -
               let description = get_string "description" in

     

       40
       40
       -
               let invite_only = get_bool "invite_only" false in

     

       41
       41
       -
               let history_public_to_subscribers = get_bool "history_public_to_subscribers" true in

     

       42
       42
       -
               

     

       43
       43
       -
               Ok { name; description; invite_only; history_public_to_subscribers }

     

       44
       44
       -
           | _ -> 

     

       45
       45
       -
               Error (Zulip_types.create_error ~code:(Other "json_parse_error") ~msg:"Channel JSON must be an object" ())

     

       46
       46
       -
         with

     

       47
       47
       -
         | exn ->

     

       48
       48
       -
             Error (Zulip_types.create_error ~code:(Other "json_parse_error") ~msg:("Channel JSON parsing failed: " ^ Printexc.to_string exn) ())

     

       18
       18
       +
       (* Jsont codec for channel *)

     

       19
       19
       +
       let jsont =

     

       20
       20
       +
         let kind = "Channel" in

     

       21
       21
       +
         let doc = "A Zulip channel (stream)" in

     

       22
       22
       +
         let make name description invite_only history_public_to_subscribers =

     

       23
       23
       +
           { name; description; invite_only; history_public_to_subscribers }

     

       24
       24
       +
         in

     

       25
       25
       +
         Jsont.Object.map ~kind ~doc make

     

       26
       26
       +
         |> Jsont.Object.mem "name" Jsont.string ~enc:name

     

       27
       27
       +
         |> Jsont.Object.mem "description" Jsont.string ~enc:description

     

       28
       28
       +
         |> Jsont.Object.mem "invite_only" Jsont.bool ~enc:invite_only

     

       29
       29
       +
         |> Jsont.Object.mem "history_public_to_subscribers" Jsont.bool ~enc:history_public_to_subscribers

     

       30
       30
       +
         |> Jsont.Object.finish

     

       31
       31
       +
       

     

       32
       32
       +
       (* Decode and encode functions using Encode module *)

     

       33
       33
       +
       let of_json json =

     

       34
       34
       +
         match Encode.from_json jsont json with

     

       35
       35
       +
         | Ok v -> Ok v

     

       36
       36
       +
         | Error msg -> Error (Zulip_types.create_error ~code:(Other "json_parse_error") ~msg ())

     

       37
       37
       +
       

     

       38
       38
       +
       let to_json_string t =

     

       39
       39
       +
         Encode.to_json_string jsont t

     

       49
       40
        
       

     

       50
       50
       -
       let pp fmt t = Format.fprintf fmt "Channel{name=%s, description=%s}" t.name t.description
     

       41
       41
       +
       let to_form_urlencoded t =

     

       42
       42
       +
         Encode.to_form_urlencoded jsont t

+17 -6

stack/zulip/lib/zulip/lib/channel.mli

···

       1
       1
        
       type t

     

       2
       2
        
       

     

       3
       3
       -
       val create : 

     

       4
       4
       -
         name:string -> 

     

       5
       5
       -
         description:string -> 

     

       6
       6
       -
         ?invite_only:bool -> 

     

       7
       7
       -
         ?history_public_to_subscribers:bool -> 

     

       3
       3
       +
       val create :

     

       4
       4
       +
         name:string ->

     

       5
       5
       +
         description:string ->

     

       6
       6
       +
         ?invite_only:bool ->

     

       7
       7
       +
         ?history_public_to_subscribers:bool ->

     

       8
       8
        
         unit -> t

     

       9
       9
        
       

     

       10
       10
        
       val name : t -> string

     

       11
       11
        
       val description : t -> string

     

       12
       12
        
       val invite_only : t -> bool

     

       13
       13
        
       val history_public_to_subscribers : t -> bool

     

       14
       14
       -
       val to_json : t -> Zulip_types.json

     

       14
       14
       +
       

     

       15
       15
       +
       (** Jsont codec for the channel type *)

     

       16
       16
       +
       val jsont : t Jsont.t

     

       17
       17
       +
       

     

       18
       18
       +
       (** Decode from Jsont.json *)

     

       15
       19
        
       val of_json : Zulip_types.json -> (t, Zulip_types.zerror) result

     

       20
       20
       +
       

     

       21
       21
       +
       (** Encode to JSON string *)

     

       22
       22
       +
       val to_json_string : t -> string

     

       23
       23
       +
       

     

       24
       24
       +
       (** Encode to form-urlencoded string *)

     

       25
       25
       +
       val to_form_urlencoded : t -> string

     

       26
       26
       +
       

     

       16
       27
        
       val pp : Format.formatter -> t -> unit

+53 -43

stack/zulip/lib/zulip/lib/channels.ml

···

       1
       1
       -
       let create_channel client channel = 

     

       2
       2
       -
         let body = match Channel.to_json channel with

     

       3
       3
       -
           | `O fields -> 

     

       4
       4
       -
               String.concat "&" (List.map (fun (k, v) -> 

     

       5
       5
       -
                 match v with 

     

       6
       6
       -
                 | `String s -> k ^ "=" ^ Uri.pct_encode s

     

       7
       7
       -
                 | `Bool b -> k ^ "=" ^ string_of_bool b

     

       8
       8
       -
                 | _ -> ""

     

       9
       9
       -
               ) fields)

     

       10
       10
       -
           | _ -> "" in

     

       11
       11
       -
         match Client.request client ~method_:`POST ~path:"/api/v1/streams" ~body () with

     

       1
       1
       +
       let create_channel client channel =

     

       2
       2
       +
         let body = Channel.to_form_urlencoded channel in

     

       3
       3
       +
         let content_type = "application/x-www-form-urlencoded" in

     

       4
       4
       +
         match Client.request client ~method_:`POST ~path:"/api/v1/streams" ~body ~content_type () with

     

       12
       5
        
         | Ok _json -> Ok ()

     

       13
       6
        
         | Error err -> Error err

     

       14
       7
        
       

     

       15
       15
       -
       let delete client ~name = 

     

       8
       8
       +
       let delete client ~name =

     

       16
       9
        
         let encoded_name = Uri.pct_encode name in

     

       17
       10
        
         match Client.request client ~method_:`DELETE ~path:("/api/v1/streams/" ^ encoded_name) () with

     

       18
       11
        
         | Ok _json -> Ok ()

     

       19
       12
        
         | Error err -> Error err

     

       20
       13
        
       

     

       21
       21
       -
       let list client = 

     

       14
       14
       +
       let list client =

     

       15
       15
       +
         (* Define response codec *)

     

       16
       16
       +
         let response_codec =

     

       17
       17
       +
           Jsont.Object.(

     

       18
       18
       +
             map ~kind:"StreamsResponse" (fun streams -> streams)

     

       19
       19
       +
             |> mem "streams" (Jsont.list Channel.jsont) ~enc:(fun x -> x)

     

       20
       20
       +
             |> finish

     

       21
       21
       +
           )

     

       22
       22
       +
         in

     

       23
       23
       +
       

     

       22
       24
        
         match Client.request client ~method_:`GET ~path:"/api/v1/streams" () with

     

       23
       23
       -
         | Ok json -> 

     

       24
       24
       -
             (match json with

     

       25
       25
       -
              | `O fields ->

     

       26
       26
       -
                  (match List.assoc_opt "streams" fields with

     

       27
       27
       -
                   | Some (`A channel_list) ->

     

       28
       28
       -
                       let channels = List.fold_left (fun acc channel_json ->

     

       29
       29
       -
                         match Channel.of_json channel_json with

     

       30
       30
       -
                         | Ok channel -> channel :: acc

     

       31
       31
       -
                         | Error _ -> acc

     

       32
       32
       -
                       ) [] channel_list in

     

       33
       33
       -
                       Ok (List.rev channels)

     

       34
       34
       -
                   | _ -> Error (Zulip_types.create_error ~code:(Other "api_error") ~msg:"Invalid streams response format" ()))

     

       35
       35
       -
              | _ -> Error (Zulip_types.create_error ~code:(Other "api_error") ~msg:"Streams response must be an object" ()))

     

       25
       25
       +
         | Ok json ->

     

       26
       26
       +
             (match Encode.from_json response_codec json with

     

       27
       27
       +
              | Ok channels -> Ok channels

     

       28
       28
       +
              | Error msg -> Error (Zulip_types.create_error ~code:(Other "api_error") ~msg ()))

     

       36
       29
        
         | Error err -> Error err

     

       37
       30
        
       

     

       38
       38
       -
       let subscribe client ~channels = 

     

       39
       39
       -
         let channels_json = `A (List.map (fun name -> `String name) channels) in

     

       40
       40
       -
         let body = "subscriptions=" ^ (match channels_json with

     

       41
       41
       -
           | `A items -> "[" ^ String.concat "," (List.map (function 

     

       42
       42
       -
               | `String s -> "\"" ^ s ^ "\""

     

       43
       43
       -
               | _ -> "") items) ^ "]"

     

       44
       44
       -
           | _ -> "[]") in

     

       45
       45
       -
         match Client.request client ~method_:`POST ~path:"/api/v1/users/me/subscriptions" ~body () with

     

       31
       31
       +
       (* Request types with jsont codecs *)

     

       32
       32
       +
       module Subscribe_request = struct

     

       33
       33
       +
         type t = { subscriptions : string list }

     

       34
       34
       +
       

     

       35
       35
       +
         let codec =

     

       36
       36
       +
           Jsont.Object.(

     

       37
       37
       +
             map ~kind:"SubscribeRequest" (fun subscriptions -> { subscriptions })

     

       38
       38
       +
             |> mem "subscriptions" (Jsont.list Jsont.string) ~enc:(fun r -> r.subscriptions)

     

       39
       39
       +
             |> finish

     

       40
       40
       +
           )

     

       41
       41
       +
       end

     

       42
       42
       +
       

     

       43
       43
       +
       module Unsubscribe_request = struct

     

       44
       44
       +
         type t = { delete : string list }

     

       45
       45
       +
       

     

       46
       46
       +
         let codec =

     

       47
       47
       +
           Jsont.Object.(

     

       48
       48
       +
             map ~kind:"UnsubscribeRequest" (fun delete -> { delete })

     

       49
       49
       +
             |> mem "delete" (Jsont.list Jsont.string) ~enc:(fun r -> r.delete)

     

       50
       50
       +
             |> finish

     

       51
       51
       +
           )

     

       52
       52
       +
       end

     

       53
       53
       +
       

     

       54
       54
       +
       let subscribe client ~channels =

     

       55
       55
       +
         let req = Subscribe_request.{ subscriptions = channels } in

     

       56
       56
       +
         let body = Encode.to_form_urlencoded Subscribe_request.codec req in

     

       57
       57
       +
         let content_type = "application/x-www-form-urlencoded" in

     

       58
       58
       +
         match Client.request client ~method_:`POST ~path:"/api/v1/users/me/subscriptions" ~body ~content_type () with

     

       46
       59
        
         | Ok _json -> Ok ()

     

       47
       60
        
         | Error err -> Error err

     

       48
       61
        
       

     

       49
       49
       -
       let unsubscribe client ~channels = 

     

       50
       50
       -
         let channels_json = `A (List.map (fun name -> `String name) channels) in

     

       51
       51
       -
         let body = "delete=" ^ (match channels_json with

     

       52
       52
       -
           | `A items -> "[" ^ String.concat "," (List.map (function 

     

       53
       53
       -
               | `String s -> "\"" ^ s ^ "\""

     

       54
       54
       -
               | _ -> "") items) ^ "]"

     

       55
       55
       -
           | _ -> "[]") in

     

       56
       56
       -
         match Client.request client ~method_:`DELETE ~path:"/api/v1/users/me/subscriptions" ~body () with

     

       62
       62
       +
       let unsubscribe client ~channels =

     

       63
       63
       +
         let req = Unsubscribe_request.{ delete = channels } in

     

       64
       64
       +
         let body = Encode.to_form_urlencoded Unsubscribe_request.codec req in

     

       65
       65
       +
         let content_type = "application/x-www-form-urlencoded" in

     

       66
       66
       +
         match Client.request client ~method_:`DELETE ~path:"/api/v1/users/me/subscriptions" ~body ~content_type () with

     

       57
       67
        
         | Ok _json -> Ok ()

     

       58
       58
       -
         | Error err -> Error err
     

       68
       68
       +
         | Error err -> Error err

+16 -14

stack/zulip/lib/zulip/lib/client.ml

···

       85
       85
        
           Buffer.contents buf

     

       86
       86
        
         in

     

       87
       87
        
       

     

       88
       88
       -
         (* Parse JSON response using Ezjsonm *)

     

       88
       88
       +
         (* Parse JSON response using Jsont_bytesrw *)

     

       89
       89
        
         let json =

     

       90
       90
       -
           try

     

       91
       91
       -
             Ezjsonm.from_string body_str

     

       92
       92
       -
           with Ezjsonm.Parse_error (_, msg) ->

     

       93
       93
       -
             Log.err (fun m -> m "JSON parse error: %s" msg);

     

       94
       94
       -
             failwith ("JSON parse error: " ^ msg)

     

       90
       90
       +
           match Jsont_bytesrw.decode_string' Jsont.json body_str with

     

       91
       91
       +
           | Ok j -> j

     

       92
       92
       +
           | Error e ->

     

       93
       93
       +
               let msg = Jsont.Error.to_string e in

     

       94
       94
       +
               Log.err (fun m -> m "JSON parse error: %s" msg);

     

       95
       95
       +
               failwith ("JSON parse error: " ^ msg)

     

       95
       96
        
         in

     

       96
       97
        
       

     

       97
       98
        
         (* Check for Zulip error response *)

     

       98
       99
        
         match json with

     

       99
       99
       -
         | `O fields ->

     

       100
       100
       -
             (match List.assoc_opt "result" fields with

     

       101
       101
       -
              | Some (`String "error") ->

     

       102
       102
       -
                  let msg = match List.assoc_opt "msg" fields with

     

       103
       103
       -
                    | Some (`String s) -> s

     

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

     

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

     

       102
       102
       +
             (match List.assoc_opt "result" assoc with

     

       103
       103
       +
              | Some (Jsont.String ("error", _)) ->

     

       104
       104
       +
                  let msg = match List.assoc_opt "msg" assoc with

     

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

     

       104
       106
        
                    | _ -> "Unknown error"

     

       105
       107
        
                  in

     

       106
       106
       -
                  let code = match List.assoc_opt "code" fields with

     

       107
       107
       -
                    | Some (`String s) -> Zulip_types.error_code_of_string s

     

       108
       108
       +
                  let code = match List.assoc_opt "code" assoc with

     

       109
       109
       +
                    | Some (Jsont.String (s, _)) -> Zulip_types.error_code_of_string s

     

       108
       110
        
                    | _ -> Zulip_types.Other "unknown"

     

       109
       111
        
                  in

     

       110
       112
        
                  Log.warn (fun m -> m "API error: %s (code: %s)" msg

     
···

       126
       128
        
                        ~msg:"Invalid JSON response" ()))

     

       127
       129
        
       

     

       128
       130
        
       let pp fmt t =

     

       129
       129
       -
         Format.fprintf fmt "Client(server=%s)" (Auth.server_url t.auth)
     

       131
       131
       +
         Format.fprintf fmt "Client(server=%s)" (Auth.server_url t.auth)

+1 -1

stack/zulip/lib/zulip/lib/dune

···

       1
       1
        
       (library

     

       2
       2
        
        (public_name zulip)

     

       3
       3
        
        (name zulip)

     

       4
       4
       -
        (libraries eio requests ezjsonm uri base64 logs))
     

       4
       4
       +
        (libraries eio requests jsont jsont.bytesrw uri base64 logs))

+56

stack/zulip/lib/zulip/lib/encode.ml

···

       1
       1
       +
       (** Encoding utilities for Zulip API requests *)

     

       2
       2
       +
       

     

       3
       3
       +
       (** Convert a jsont-encoded value to JSON string *)

     

       4
       4
       +
       let to_json_string : 'a Jsont.t -> 'a -> string = fun codec value ->

     

       5
       5
       +
         match Jsont_bytesrw.encode_string' codec value with

     

       6
       6
       +
         | Ok s -> s

     

       7
       7
       +
         | Error e -> failwith ("JSON encoding error: " ^ Jsont.Error.to_string e)

     

       8
       8
       +
       

     

       9
       9
       +
       (** Convert a jsont-encoded value to form-urlencoded string *)

     

       10
       10
       +
       let to_form_urlencoded : 'a Jsont.t -> 'a -> string = fun codec value ->

     

       11
       11
       +
         (* First encode to JSON, then extract fields *)

     

       12
       12
       +
         let json_str = to_json_string codec value in

     

       13
       13
       +
         match Jsont_bytesrw.decode_string' Jsont.json json_str with

     

       14
       14
       +
         | Error e -> failwith ("JSON decode error: " ^ Jsont.Error.to_string e)

     

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

     

       16
       16
       +
             (* Convert object fields to form-urlencoded *)

     

       17
       17
       +
             let encode_value = function

     

       18
       18
       +
               | Jsont.String (s, _) -> Some (Uri.pct_encode ~component:`Query_value s)

     

       19
       19
       +
               | Jsont.Bool (b, _) -> Some (string_of_bool b)

     

       20
       20
       +
               | Jsont.Number (n, _) -> Some (string_of_float n)

     

       21
       21
       +
               | Jsont.Null _ -> None

     

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

     

       23
       23
       +
                   (* For arrays, encode as JSON array string *)

     

       24
       24
       +
                   let array_str = "[" ^ String.concat "," (List.filter_map (function

     

       25
       25
       +
                     | Jsont.String (s, _) -> Some ("\"" ^ String.escaped s ^ "\"")

     

       26
       26
       +
                     | Jsont.Number (n, _) -> Some (string_of_float n)

     

       27
       27
       +
                     | Jsont.Bool (b, _) -> Some (string_of_bool b)

     

       28
       28
       +
                     | _ -> None

     

       29
       29
       +
                   ) items) ^ "]" in

     

       30
       30
       +
                   Some array_str

     

       31
       31
       +
               | Jsont.Object _ -> None (* Skip nested objects *)

     

       32
       32
       +
             in

     

       33
       33
       +
       

     

       34
       34
       +
             let params = List.filter_map (fun ((key, _), value) ->

     

       35
       35
       +
               match encode_value value with

     

       36
       36
       +
               | Some encoded -> Some (key ^ "=" ^ encoded)

     

       37
       37
       +
               | None -> None

     

       38
       38
       +
             ) fields in

     

       39
       39
       +
       

     

       40
       40
       +
             String.concat "&" params

     

       41
       41
       +
         | Ok _ ->

     

       42
       42
       +
             failwith "Expected JSON object for form encoding"

     

       43
       43
       +
       

     

       44
       44
       +
       (** Parse JSON string using a jsont codec *)

     

       45
       45
       +
       let from_json_string : 'a Jsont.t -> string -> ('a, string) result = fun codec json_str ->

     

       46
       46
       +
         match Jsont_bytesrw.decode_string' codec json_str with

     

       47
       47
       +
         | Ok v -> Ok v

     

       48
       48
       +
         | Error e -> Error (Jsont.Error.to_string e)

     

       49
       49
       +
       

     

       50
       50
       +
       (** Parse a Jsont.json value using a codec *)

     

       51
       51
       +
       let from_json : 'a Jsont.t -> Jsont.json -> ('a, string) result = fun codec json ->

     

       52
       52
       +
         let json_str = match Jsont_bytesrw.encode_string' Jsont.json json with

     

       53
       53
       +
           | Ok s -> s

     

       54
       54
       +
           | Error e -> failwith ("Failed to re-encode json: " ^ Jsont.Error.to_string e)

     

       55
       55
       +
         in

     

       56
       56
       +
         from_json_string codec json_str

+21

stack/zulip/lib/zulip/lib/encode.mli

···

       1
       1
       +
       (** Encoding utilities for Zulip API requests *)

     

       2
       2
       +
       

     

       3
       3
       +
       (** Convert a value to JSON string using its jsont codec *)

     

       4
       4
       +
       val to_json_string : 'a Jsont.t -> 'a -> string

     

       5
       5
       +
       

     

       6
       6
       +
       (** Convert a value to application/x-www-form-urlencoded string using its jsont codec

     

       7
       7
       +
       

     

       8
       8
       +
           The codec should represent a JSON object. Fields will be converted to key=value pairs:

     

       9
       9
       +
           - Strings: URL-encoded

     

       10
       10
       +
           - Booleans: "true"/"false"

     

       11
       11
       +
           - Numbers: string representation

     

       12
       12
       +
           - Arrays: JSON array string "[...]"

     

       13
       13
       +
           - Null: omitted

     

       14
       14
       +
           - Nested objects: omitted *)

     

       15
       15
       +
       val to_form_urlencoded : 'a Jsont.t -> 'a -> string

     

       16
       16
       +
       

     

       17
       17
       +
       (** Parse JSON string using a jsont codec *)

     

       18
       18
       +
       val from_json_string : 'a Jsont.t -> string -> ('a, string) result

     

       19
       19
       +
       

     

       20
       20
       +
       (** Parse a Jsont.json value using a codec *)

     

       21
       21
       +
       val from_json : 'a Jsont.t -> Jsont.json -> ('a, string) result

+35 -24

stack/zulip/lib/zulip/lib/event.ml

···

       8
       8
        
       let type_ t = t.type_

     

       9
       9
        
       let data t = t.data

     

       10
       10
        
       

     

       11
       11
       -
       let of_json json = 

     

       11
       11
       +
       let pp fmt t = Format.fprintf fmt "Event{id=%d, type=%a}" t.id Event_type.pp t.type_

     

       12
       12
       +
       

     

       13
       13
       +
       (* Helper to extract fields from Jsont.json *)

     

       14
       14
       +
       let get_int_field json name =

     

       15
       15
       +
         match json with

     

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

     

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

     

       18
       18
       +
             (match List.assoc_opt name assoc with

     

       19
       19
       +
              | Some (Jsont.Number (n, _)) -> int_of_float n

     

       20
       20
       +
              | _ -> Jsont.Error.msg Jsont.Meta.none

     

       21
       21
       +
                  (Format.sprintf "Field '%s' not found or not an int" name))

     

       22
       22
       +
         | _ -> Jsont.Error.msg Jsont.Meta.none "Expected JSON object"

     

       23
       23
       +
       

     

       24
       24
       +
       let get_string_field json name =

     

       25
       25
       +
         match json with

     

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

     

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

     

       28
       28
       +
             (match List.assoc_opt name assoc with

     

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

     

       30
       30
       +
              | _ -> Jsont.Error.msg Jsont.Meta.none

     

       31
       31
       +
                  (Format.sprintf "Field '%s' not found or not a string" name))

     

       32
       32
       +
         | _ -> Jsont.Error.msg Jsont.Meta.none "Expected JSON object"

     

       33
       33
       +
       

     

       34
       34
       +
       (* Simple decoder that extracts id and type, keeping full JSON as data *)

     

       35
       35
       +
       let of_json_direct json =

     

       12
       36
        
         try

     

       13
       13
       -
           match json with

     

       14
       14
       -
           | `O fields ->

     

       15
       15
       -
               let get_int key = 

     

       16
       16
       -
                 match List.assoc key fields with 

     

       17
       17
       -
                 | `Float f -> int_of_float f

     

       18
       18
       -
                 | _ -> failwith ("Expected int for " ^ key) in

     

       19
       19
       -
               let get_string key = 

     

       20
       20
       -
                 match List.assoc key fields with 

     

       21
       21
       -
                 | `String s -> s 

     

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

     

       23
       23
       -
               let id = get_int "id" in

     

       24
       24
       -
               let type_str = get_string "type" in

     

       25
       25
       -
               let type_ = Event_type.of_string type_str in

     

       26
       26
       -
               (* The whole event is the data - store it all *)

     

       27
       27
       -
               let data = json in

     

       37
       37
       +
           let id = get_int_field json "id" in

     

       38
       38
       +
           let type_str = get_string_field json "type" in

     

       39
       39
       +
           let type_ = Event_type.of_string type_str in

     

       40
       40
       +
           Ok { id; type_; data = json }

     

       41
       41
       +
         with e ->

     

       42
       42
       +
           Error (Zulip_types.create_error ~code:(Other "json_parse_error")

     

       43
       43
       +
             ~msg:("Event JSON parsing failed: " ^ Printexc.to_string e) ())

     

       28
       44
        
       

     

       29
       29
       -
               Ok { id; type_; data }

     

       30
       30
       -
           | _ -> 

     

       31
       31
       -
               Error (Zulip_types.create_error ~code:(Other "json_parse_error") ~msg:"Event JSON must be an object" ())

     

       32
       32
       -
         with

     

       33
       33
       -
         | exn ->

     

       34
       34
       -
             Error (Zulip_types.create_error ~code:(Other "json_parse_error") ~msg:("Event JSON parsing failed: " ^ Printexc.to_string exn) ())

     

       35
       35
       -
       

     

       36
       36
       -
       let pp fmt t = Format.fprintf fmt "Event{id=%d, type=%a}" t.id Event_type.pp t.type_
     

       45
       45
       +
       (* Decode function *)

     

       46
       46
       +
       let of_json json =

     

       47
       47
       +
         of_json_direct json

+79 -42

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

···

       6
       6
        
         id : string;

     

       7
       7
        
       }

     

       8
       8
        
       

     

       9
       9
       +
       (* Request/response codecs *)

     

       10
       10
       +
       module Register_request = struct

     

       11
       11
       +
         type t = { event_types : string list option }

     

       12
       12
       +
       

     

       13
       13
       +
         let codec =

     

       14
       14
       +
           Jsont.Object.(

     

       15
       15
       +
             map ~kind:"RegisterRequest" (fun event_types -> { event_types })

     

       16
       16
       +
             |> opt_mem "event_types" (Jsont.list Jsont.string) ~enc:(fun r -> r.event_types)

     

       17
       17
       +
             |> finish

     

       18
       18
       +
           )

     

       19
       19
       +
       end

     

       20
       20
       +
       

     

       21
       21
       +
       module Register_response = struct

     

       22
       22
       +
         type t = { queue_id : string }

     

       23
       23
       +
       

     

       24
       24
       +
         let codec =

     

       25
       25
       +
           Jsont.Object.(

     

       26
       26
       +
             map ~kind:"RegisterResponse" (fun queue_id -> { queue_id })

     

       27
       27
       +
             |> mem "queue_id" Jsont.string ~enc:(fun r -> r.queue_id)

     

       28
       28
       +
             |> finish

     

       29
       29
       +
           )

     

       30
       30
       +
       end

     

       31
       31
       +
       

     

       9
       32
        
       let register client ?event_types () =

     

       10
       10
       -
         let params = match event_types with

     

       11
       11
       -
           | None -> []

     

       12
       12
       -
           | Some types ->

     

       13
       13
       -
               let types_json = "[" ^

     

       14
       14
       -
                 String.concat "," (List.map (fun t -> "\"" ^ Event_type.to_string t ^ "\"") types) ^

     

       15
       15
       -
                 "]"

     

       16
       16
       -
               in

     

       17
       17
       -
               Log.debug (fun m -> m "Registering with event_types: %s" types_json);

     

       18
       18
       -
               [("event_types", types_json)]

     

       19
       19
       -
         in

     

       20
       20
       -
         match Client.request client ~method_:`POST ~path:"/api/v1/register" ~params () with

     

       21
       21
       -
         | Ok json -> 

     

       22
       22
       -
             (match json with

     

       23
       23
       -
              | `O fields ->

     

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

     

       25
       25
       -
                   | Some (`String queue_id) -> Ok { id = queue_id }

     

       26
       26
       -
                   | _ -> Error (Zulip_types.create_error ~code:(Other "api_error") ~msg:"Invalid register response: missing queue_id" ()))

     

       27
       27
       -
              | _ -> Error (Zulip_types.create_error ~code:(Other "api_error") ~msg:"Register response must be an object" ()))

     

       33
       33
       +
         let event_types_str = Option.map (List.map Event_type.to_string) event_types in

     

       34
       34
       +
         let req = Register_request.{ event_types = event_types_str } in

     

       35
       35
       +
         let body = Encode.to_form_urlencoded Register_request.codec req in

     

       36
       36
       +
         let content_type = "application/x-www-form-urlencoded" in

     

       37
       37
       +
       

     

       38
       38
       +
         (match event_types_str with

     

       39
       39
       +
          | Some types -> Log.debug (fun m -> m "Registering with event_types: %s" (String.concat "," types))

     

       40
       40
       +
          | None -> ());

     

       41
       41
       +
       

     

       42
       42
       +
         match Client.request client ~method_:`POST ~path:"/api/v1/register" ~body ~content_type () with

     

       43
       43
       +
         | Ok json ->

     

       44
       44
       +
             (match Encode.from_json Register_response.codec json with

     

       45
       45
       +
              | Ok response -> Ok { id = response.queue_id }

     

       46
       46
       +
              | Error msg -> Error (Zulip_types.create_error ~code:(Other "api_error") ~msg ()))

     

       28
       47
        
         | Error err -> Error err

     

       29
       48
        
       

     

       30
       49
        
       let id t = t.id

     

       31
       50
        
       

     

       32
       32
       -
       let get_events t client ?last_event_id () = 

     

       33
       33
       -
         let params = [("queue_id", t.id)] @ 

     

       51
       51
       +
       (* Events response codec - events field is optional (may not be present) *)

     

       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
       56
       +
         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, _)) ->

     

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

     

       63
       63
       +
                 (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

     

       67
       67
       +
                        | Ok event -> event :: acc

     

       68
       68
       +
                        | 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"

     

       74
       74
       +
           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

     

       80
       80
       +
       end

     

       81
       81
       +
       

     

       82
       82
       +
       let get_events t client ?last_event_id () =

     

       83
       83
       +
         let params = [("queue_id", t.id)] @

     

       34
       84
        
           (match last_event_id with

     

       35
       85
        
            | None -> []

     

       36
       86
        
            | Some event_id -> [("last_event_id", string_of_int event_id)]) in

     

       37
       87
        
         match Client.request client ~method_:`GET ~path:"/api/v1/events" ~params () with

     

       38
       38
       -
         | Ok json -> 

     

       39
       39
       -
             (match json with

     

       40
       40
       -
              | `O fields ->

     

       41
       41
       -
                  (match List.assoc_opt "events" fields with

     

       42
       42
       -
                   | Some (`A event_list) ->

     

       43
       43
       -
                       Log.debug (fun m -> m "Got %d raw events from API" (List.length event_list));

     

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

     

       45
       45
       -
                         match Event.of_json event_json with

     

       46
       46
       -
                         | Ok event -> event :: acc

     

       47
       47
       -
                         | Error e ->

     

       48
       48
       -
                             Log.warn (fun m -> m "Failed to parse event: %s" (Zulip_types.error_message e));

     

       49
       49
       -
                             acc

     

       50
       50
       -
                       ) [] event_list in

     

       51
       51
       -
                       Ok (List.rev events)

     

       52
       52
       -
                   | Some _other ->

     

       53
       53
       -
                       Log.warn (fun m -> m "Events field is not an array");

     

       54
       54
       -
                       Error (Zulip_types.create_error ~code:(Other "api_error") ~msg:"Invalid events response format" ())

     

       55
       55
       -
                   | None ->

     

       56
       56
       -
                       Log.debug (fun m -> m "No events field in response");

     

       57
       57
       -
                       Ok [])

     

       58
       58
       -
              | _ -> Error (Zulip_types.create_error ~code:(Other "api_error") ~msg:"Events response must be an object" ()))

     

       88
       88
       +
         | Ok json ->

     

       89
       89
       +
             (match Encode.from_json Events_response.codec json with

     

       90
       90
       +
              | Ok response ->

     

       91
       91
       +
                  Log.debug (fun m -> m "Got %d events from API" (List.length response.events));

     

       92
       92
       +
                  Ok response.events

     

       93
       93
       +
              | Error msg ->

     

       94
       94
       +
                  Log.warn (fun m -> m "Failed to parse events response: %s" msg);

     

       95
       95
       +
                  Error (Zulip_types.create_error ~code:(Other "api_error") ~msg ()))

     

       59
       96
        
         | Error err -> Error err

     

       60
       97
        
       

     

       61
       61
       -
       let delete t client = 

     

       98
       98
       +
       let delete t client =

     

       62
       99
        
         let params = [("queue_id", t.id)] in

     

       63
       100
        
         match Client.request client ~method_:`DELETE ~path:"/api/v1/events" ~params () with

     

       64
       101
        
         | Ok _json -> Ok ()

-206

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

···

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

     

       2
       2
       -
       

     

       3
       3
       -
       type json = Zulip_types.json

     

       4
       4
       -
       

     

       5
       5
       -
       (** {1 Field extraction utilities} *)

     

       6
       6
       -
       

     

       7
       7
       -
       let get_string fields key =

     

       8
       8
       -
         match List.assoc_opt key fields with

     

       9
       9
       -
         | Some (`String s) -> Ok s

     

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

     

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

     

       12
       12
       -
       

     

       13
       13
       -
       let get_string_default fields key default =

     

       14
       14
       -
         match get_string fields key with

     

       15
       15
       -
         | Ok s -> s

     

       16
       16
       -
         | Error _ -> default

     

       17
       17
       -
       

     

       18
       18
       -
       let get_string_opt fields key =

     

       19
       19
       -
         match List.assoc_opt key fields with

     

       20
       20
       -
         | Some (`String s) -> Some s

     

       21
       21
       -
         | _ -> None

     

       22
       22
       -
       

     

       23
       23
       -
       let to_int_flex = function

     

       24
       24
       -
         | `Float f -> int_of_float f

     

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

     

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

     

       27
       27
       -
           | `Null -> "null"

     

       28
       28
       -
           | `Bool _ -> "bool"

     

       29
       29
       -
           | `O _ -> "object"

     

       30
       30
       -
           | `A _ -> "array"

     

       31
       31
       -
           | _ -> "unknown"))

     

       32
       32
       -
       

     

       33
       33
       -
       let get_int fields key =

     

       34
       34
       -
         match List.assoc_opt key fields with

     

       35
       35
       -
         | Some json ->

     

       36
       36
       -
             (try Ok (to_int_flex json) with

     

       37
       37
       -
              | Failure msg -> Error (Zulip_types.create_error ~code:(Other "json_type_error") ~msg ()))

     

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

     

       39
       39
       -
       

     

       40
       40
       -
       let get_int_default fields key default =

     

       41
       41
       -
         match get_int fields key with

     

       42
       42
       -
         | Ok i -> i

     

       43
       43
       -
         | Error _ -> default

     

       44
       44
       -
       

     

       45
       45
       -
       let get_int_opt fields key =

     

       46
       46
       -
         match List.assoc_opt key fields with

     

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

     

       48
       48
       -
         | None -> None

     

       49
       49
       -
       

     

       50
       50
       -
       let get_float fields key =

     

       51
       51
       -
         match List.assoc_opt key fields with

     

       52
       52
       -
         | Some (`Float f) -> Ok f

     

       53
       53
       -
         | Some (`String s) ->

     

       54
       54
       -
             (try Ok (float_of_string s) with

     

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

     

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

     

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

     

       58
       58
       -
       

     

       59
       59
       -
       let get_float_default fields key default =

     

       60
       60
       -
         match get_float fields key with

     

       61
       61
       -
         | Ok f -> f

     

       62
       62
       -
         | Error _ -> default

     

       63
       63
       -
       

     

       64
       64
       -
       let get_bool fields key =

     

       65
       65
       -
         match List.assoc_opt key fields with

     

       66
       66
       -
         | Some (`Bool b) -> Ok b

     

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

     

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

     

       69
       69
       -
       

     

       70
       70
       -
       let get_bool_default fields key default =

     

       71
       71
       -
         match get_bool fields key with

     

       72
       72
       -
         | Ok b -> b

     

       73
       73
       -
         | Error _ -> default

     

       74
       74
       -
       

     

       75
       75
       -
       let get_bool_opt fields key =

     

       76
       76
       -
         match List.assoc_opt key fields with

     

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

     

       78
       78
       -
         | _ -> None

     

       79
       79
       -
       

     

       80
       80
       -
       let get_object fields key =

     

       81
       81
       -
         match List.assoc_opt key fields with

     

       82
       82
       -
         | Some (`O obj) -> Ok obj

     

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

     

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

     

       85
       85
       -
       

     

       86
       86
       -
       let get_object_opt fields key =

     

       87
       87
       -
         match List.assoc_opt key fields with

     

       88
       88
       -
         | Some (`O obj) -> Some obj

     

       89
       89
       -
         | _ -> None

     

       90
       90
       -
       

     

       91
       91
       -
       let get_array fields key =

     

       92
       92
       -
         match List.assoc_opt key fields with

     

       93
       93
       -
         | Some (`A arr) -> Ok arr

     

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

     

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

     

       96
       96
       -
       

     

       97
       97
       -
       let get_array_opt fields key =

     

       98
       98
       -
         match List.assoc_opt key fields with

     

       99
       99
       -
         | Some (`A arr) -> Some arr

     

       100
       100
       -
         | _ -> None

     

       101
       101
       -
       

     

       102
       102
       -
       (** {1 Type conversion utilities} *)

     

       103
       103
       -
       

     

       104
       104
       -
       let to_int_safe = function

     

       105
       105
       -
         | `Float f -> Some (int_of_float f)

     

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

     

       107
       107
       -
         | _ -> None

     

       108
       108
       -
       

     

       109
       109
       -
       let to_string_safe = function

     

       110
       110
       -
         | `String s -> Some s

     

       111
       111
       -
         | _ -> None

     

       112
       112
       -
       

     

       113
       113
       -
       let to_bool_safe = function

     

       114
       114
       -
         | `Bool b -> Some b

     

       115
       115
       -
         | _ -> None

     

       116
       116
       -
       

     

       117
       117
       -
       let to_float_safe = function

     

       118
       118
       -
         | `Float f -> Some f

     

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

     

       120
       120
       -
         | _ -> None

     

       121
       121
       -
       

     

       122
       122
       -
       (** {1 Object parsing utilities} *)

     

       123
       123
       -
       

     

       124
       124
       -
       let with_object context f = function

     

       125
       125
       -
         | `O fields -> f fields

     

       126
       126
       -
         | _ -> Error (Zulip_types.create_error ~code:(Other "json_type_error") ~msg:(Printf.sprintf "%s: expected JSON object" context) ())

     

       127
       127
       -
       

     

       128
       128
       -
       let with_array context f json =

     

       129
       129
       -
         match json with

     

       130
       130
       -
         | `A items ->

     

       131
       131
       -
             let rec process acc = function

     

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

     

       133
       133
       -
               | item :: rest ->

     

       134
       134
       -
                   match f item with

     

       135
       135
       -
                   | Ok v -> process (v :: acc) rest

     

       136
       136
       -
                   | Error e -> Error e

     

       137
       137
       -
             in

     

       138
       138
       -
             process [] items

     

       139
       139
       -
         | _ -> Error (Zulip_types.create_error ~code:(Other "json_type_error") ~msg:(Printf.sprintf "%s: expected JSON array" context) ())

     

       140
       140
       -
       

     

       141
       141
       -
       (** {1 Construction utilities} *)

     

       142
       142
       -
       

     

       143
       143
       -
       let optional_field key encoder = function

     

       144
       144
       -
         | Some value -> Some (key, encoder value)

     

       145
       145
       -
         | None -> None

     

       146
       146
       -
       

     

       147
       147
       -
       let optional_fields fields =

     

       148
       148
       -
         List.filter_map (fun x -> x) fields

     

       149
       149
       -
       

     

       150
       150
       -
       let string_array strings =

     

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

     

       152
       152
       -
       

     

       153
       153
       -
       let int_array ints =

     

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

     

       155
       155
       -
       

     

       156
       156
       -
       (** {1 Error handling} *)

     

       157
       157
       -
       

     

       158
       158
       -
       let json_error msg =

     

       159
       159
       -
         Zulip_types.create_error ~code:(Other "json_error") ~msg ()

     

       160
       160
       -
       

     

       161
       161
       -
       let field_missing_error field =

     

       162
       162
       -
         Zulip_types.create_error ~code:(Other "json_missing_field") ~msg:(Printf.sprintf "Required field '%s' not found" field) ()

     

       163
       163
       -
       

     

       164
       164
       -
       let type_mismatch_error field expected =

     

       165
       165
       -
         Zulip_types.create_error ~code:(Other "json_type_error") ~msg:(Printf.sprintf "Field '%s' type mismatch: expected %s" field expected) ()

     

       166
       166
       -
       

     

       167
       167
       -
       let parse_with_error context f =

     

       168
       168
       -
         try f ()

     

       169
       169
       -
         with

     

       170
       170
       -
         | Failure msg -> Error (Zulip_types.create_error ~code:(Other "json_parse_error") ~msg:(Printf.sprintf "%s: %s" context msg) ())

     

       171
       171
       -
         | exn -> Error (Zulip_types.create_error ~code:(Other "json_parse_error") ~msg:(Printf.sprintf "%s: %s" context (Printexc.to_string exn)) ())

     

       172
       172
       -
       

     

       173
       173
       -
       

     

       174
       174
       -
       (** {1 Debugging utilities} *)

     

       175
       175
       -
       

     

       176
       176
       -
       let to_string_pretty json =

     

       177
       177
       -
         let rec aux indent = function

     

       178
       178
       -
           | `Null -> "null"

     

       179
       179
       -
           | `Bool b -> string_of_bool b

     

       180
       180
       -
           | `Float f ->

     

       181
       181
       -
               if float_of_int (int_of_float f) = f then

     

       182
       182
       -
                 string_of_int (int_of_float f)

     

       183
       183
       -
               else

     

       184
       184
       -
                 string_of_float f

     

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

     

       186
       186
       -
           | `A [] -> "[]"

     

       187
       187
       -
           | `A lst ->

     

       188
       188
       -
               let items = List.map (aux (indent ^ "  ")) lst in

     

       189
       189
       -
               Printf.sprintf "[\n%s%s\n%s]"

     

       190
       190
       -
                 (indent ^ "  ")

     

       191
       191
       -
                 (String.concat (",\n" ^ indent ^ "  ") items)

     

       192
       192
       -
                 indent

     

       193
       193
       -
           | `O [] -> "{}"

     

       194
       194
       -
           | `O fields ->

     

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

     

       196
       196
       -
                 Printf.sprintf "%S: %s" k (aux (indent ^ "  ") v)

     

       197
       197
       -
               ) fields in

     

       198
       198
       -
               Printf.sprintf "{\n%s%s\n%s}"

     

       199
       199
       -
                 (indent ^ "  ")

     

       200
       200
       -
                 (String.concat (",\n" ^ indent ^ "  ") items)

     

       201
       201
       -
                 indent

     

       202
       202
       -
         in

     

       203
       203
       -
         aux "" json

     

       204
       204
       -
       

     

       205
       205
       -
       let pp fmt json =

     

       206
       206
       -
         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 = Zulip_types.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, Zulip_types.zerror) 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, Zulip_types.zerror) 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, Zulip_types.zerror) 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, Zulip_types.zerror) 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, Zulip_types.zerror) 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, Zulip_types.zerror) 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, Zulip_types.zerror) result) -> json -> ('a, Zulip_types.zerror) 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, Zulip_types.zerror) result) -> json -> ('a list, Zulip_types.zerror) 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 -> Zulip_types.zerror

     

       100
       100
       -
       

     

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

     

       102
       102
       -
       val field_missing_error : string -> Zulip_types.zerror

     

       103
       103
       -
       

     

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

     

       105
       105
       -
       val type_mismatch_error : string -> string -> Zulip_types.zerror

     

       106
       106
       -
       

     

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

     

       108
       108
       -
       val parse_with_error : string -> (unit -> ('a, Zulip_types.zerror) result) -> ('a, Zulip_types.zerror) 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

-144

stack/zulip/lib/zulip/lib/jsonu_syntax.ml

···

       1
       1
       -
       (** Syntax module for monadic and applicative JSON parsing *)

     

       2
       2
       -
       

     

       3
       3
       -
       type json = Zulip_types.json

     

       4
       4
       -
       type 'a parser = json -> ('a, Zulip_types.zerror) result

     

       5
       5
       -
       

     

       6
       6
       -
       (** Monadic bind operator for sequential parsing with error handling *)

     

       7
       7
       -
       let ( let* ) = Result.bind

     

       8
       8
       -
       

     

       9
       9
       -
       (** Map operator for transforming successful results *)

     

       10
       10
       -
       let ( let+ ) x f = Result.map f x

     

       11
       11
       -
       

     

       12
       12
       -
       (** Applicative parallel composition *)

     

       13
       13
       -
       let ( and+ ) x y =

     

       14
       14
       -
         match x, y with

     

       15
       15
       -
         | Ok x, Ok y -> Ok (x, y)

     

       16
       16
       -
         | Error e, _ | _, Error e -> Error e

     

       17
       17
       -
       

     

       18
       18
       -
       (** Applicative parallel composition for 3 values *)

     

       19
       19
       -
       let ( and++ ) xy z =

     

       20
       20
       -
         match xy, z with

     

       21
       21
       -
         | Ok (x, y), Ok z -> Ok (x, y, z)

     

       22
       22
       -
         | Error e, _ | _, Error e -> Error e

     

       23
       23
       -
       

     

       24
       24
       -
       (** Applicative parallel composition for 4 values *)

     

       25
       25
       -
       let ( and+++ ) xyz w =

     

       26
       26
       -
         match xyz, w with

     

       27
       27
       -
         | Ok (x, y, z), Ok w -> Ok (x, y, z, w)

     

       28
       28
       -
         | Error e, _ | _, Error e -> Error e

     

       29
       29
       -
       

     

       30
       30
       -
       (** Applicative parallel composition for 5 values *)

     

       31
       31
       -
       let ( and++++ ) xyzw v =

     

       32
       32
       -
         match xyzw, v with

     

       33
       33
       -
         | Ok (x, y, z, w), Ok v -> Ok (x, y, z, w, v)

     

       34
       34
       -
         | Error e, _ | _, Error e -> Error e

     

       35
       35
       -
       

     

       36
       36
       -
       (** Alternative operator - try first, if fails try second *)

     

       37
       37
       -
       let ( <|> ) x y =

     

       38
       38
       -
         match x with

     

       39
       39
       -
         | Ok _ -> x

     

       40
       40
       -
         | Error _ -> y

     

       41
       41
       -
       

     

       42
       42
       -
       (** Provide a default value if parsing fails *)

     

       43
       43
       -
       let ( |? ) x default =

     

       44
       44
       -
         match x with

     

       45
       45
       -
         | Ok v -> v

     

       46
       46
       -
         | Error _ -> default

     

       47
       47
       -
       

     

       48
       48
       -
       (** Convert option to result with error message *)

     

       49
       49
       -
       let required name = function

     

       50
       50
       -
         | Some v -> Ok v

     

       51
       51
       -
         | None -> Error (Zulip_types.create_error ~code:(Other "missing_field") ~msg:(Printf.sprintf "Required field '%s' not found" name) ())

     

       52
       52
       -
       

     

       53
       53
       -
       (** Convert option to result with default *)

     

       54
       54
       -
       let default v = function

     

       55
       55
       -
         | Some x -> x

     

       56
       56
       -
         | None -> v

     

       57
       57
       -
       

     

       58
       58
       -
       (** Lift a pure value into parser context *)

     

       59
       59
       -
       let pure x = Ok x

     

       60
       60
       -
       

     

       61
       61
       -
       (** Fail with an error message *)

     

       62
       62
       -
       let fail msg = Error (Zulip_types.create_error ~code:(Other "parse_error") ~msg ())

     

       63
       63
       -
       

     

       64
       64
       -
       (** Map over a list with error handling *)

     

       65
       65
       -
       let traverse f lst =

     

       66
       66
       -
         let rec go acc = function

     

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

     

       68
       68
       -
           | x :: xs ->

     

       69
       69
       -
               let* v = f x in

     

       70
       70
       -
               go (v :: acc) xs

     

       71
       71
       -
         in

     

       72
       72
       -
         go [] lst

     

       73
       73
       -
       

     

       74
       74
       -
       (** Filter and map over a list, dropping errors *)

     

       75
       75
       -
       let filter_map f lst =

     

       76
       76
       -
         List.filter_map (fun x ->

     

       77
       77
       -
           match f x with

     

       78
       78
       -
           | Ok v -> Some v

     

       79
       79
       -
           | Error _ -> None

     

       80
       80
       -
         ) lst

     

       81
       81
       -
       

     

       82
       82
       -
       (** Parse a field with a custom parser *)

     

       83
       83
       -
       let field fields key parser =

     

       84
       84
       -
         match List.assoc_opt key fields with

     

       85
       85
       -
         | Some json -> parser json

     

       86
       86
       -
         | None -> Error (Jsonu.field_missing_error key)

     

       87
       87
       -
       

     

       88
       88
       -
       (** Parse an optional field with a custom parser *)

     

       89
       89
       -
       let field_opt fields key parser =

     

       90
       90
       -
         match List.assoc_opt key fields with

     

       91
       91
       -
         | Some json ->

     

       92
       92
       -
             (match parser json with

     

       93
       93
       -
              | Ok v -> Ok (Some v)

     

       94
       94
       -
              | Error _ -> Ok None)

     

       95
       95
       -
         | None -> Ok None

     

       96
       96
       -
       

     

       97
       97
       -
       (** Parse a field with a default value if missing or fails *)

     

       98
       98
       -
       let field_or fields key parser default =

     

       99
       99
       -
         match List.assoc_opt key fields with

     

       100
       100
       -
         | Some json ->

     

       101
       101
       -
             (match parser json with

     

       102
       102
       -
              | Ok v -> Ok v

     

       103
       103
       -
              | Error _ -> Ok default)

     

       104
       104
       -
         | None -> Ok default

     

       105
       105
       -
       

     

       106
       106
       -
       (** Common parsers *)

     

       107
       107
       -
       let string = function

     

       108
       108
       -
         | `String s -> Ok s

     

       109
       109
       -
         | _ -> Error (Zulip_types.create_error ~code:(Other "type_error") ~msg:"Expected string" ())

     

       110
       110
       -
       

     

       111
       111
       -
       let int = function

     

       112
       112
       -
         | `Float f -> Ok (int_of_float f)

     

       113
       113
       -
         | `String s ->

     

       114
       114
       -
             (try Ok (int_of_string s)

     

       115
       115
       -
              with _ -> Error (Zulip_types.create_error ~code:(Other "type_error") ~msg:"Expected integer" ()))

     

       116
       116
       -
         | _ -> Error (Zulip_types.create_error ~code:(Other "type_error") ~msg:"Expected integer" ())

     

       117
       117
       -
       

     

       118
       118
       -
       let float = function

     

       119
       119
       -
         | `Float f -> Ok f

     

       120
       120
       -
         | `String s ->

     

       121
       121
       -
             (try Ok (float_of_string s)

     

       122
       122
       -
              with _ -> Error (Zulip_types.create_error ~code:(Other "type_error") ~msg:"Expected float" ()))

     

       123
       123
       -
         | _ -> Error (Zulip_types.create_error ~code:(Other "type_error") ~msg:"Expected float" ())

     

       124
       124
       -
       

     

       125
       125
       -
       let bool = function

     

       126
       126
       -
         | `Bool b -> Ok b

     

       127
       127
       -
         | _ -> Error (Zulip_types.create_error ~code:(Other "type_error") ~msg:"Expected boolean" ())

     

       128
       128
       -
       

     

       129
       129
       -
       let array parser = function

     

       130
       130
       -
         | `A items -> traverse parser items

     

       131
       131
       -
         | _ -> Error (Zulip_types.create_error ~code:(Other "type_error") ~msg:"Expected array" ())

     

       132
       132
       -
       

     

       133
       133
       -
       let object_ = function

     

       134
       134
       -
         | `O fields -> Ok fields

     

       135
       135
       -
         | _ -> Error (Zulip_types.create_error ~code:(Other "type_error") ~msg:"Expected object" ())

     

       136
       136
       -
       

     

       137
       137
       -
       (** Run a parser on JSON *)

     

       138
       138
       -
       let parse parser json = parser json

     

       139
       139
       -
       

     

       140
       140
       -
       (** Run a parser with error context *)

     

       141
       141
       -
       let with_context ctx parser json =

     

       142
       142
       -
         match parser json with

     

       143
       143
       -
         | Ok v -> Ok v

     

       144
       144
       -
         | Error e -> Error (Zulip_types.create_error ~code:(Zulip_types.error_code e) ~msg:(Printf.sprintf "%s: %s" ctx (Zulip_types.error_message e)) ())

-96

stack/zulip/lib/zulip/lib/jsonu_syntax.mli

···

       1
       1
       -
       (** Syntax module for monadic and applicative JSON parsing

     

       2
       2
       -
       

     

       3
       3
       -
           This module provides binding operators and combinators to make JSON parsing

     

       4
       4
       -
           more ergonomic and composable. It enables code like:

     

       5
       5
       -
       

     

       6
       6
       -
           {[

     

       7
       7
       -
             let parse_user json =

     

       8
       8
       -
               with_object "user" @@ fun fields ->

     

       9
       9
       -
               let+ user_id = field fields "user_id" int

     

       10
       10
       -
               and+ email = field fields "email" string

     

       11
       11
       -
               and+ full_name = field fields "full_name" string in

     

       12
       12
       -
               { user_id; email; full_name }

     

       13
       13
       -
           ]}

     

       14
       14
       -
       *)

     

       15
       15
       -
       

     

       16
       16
       -
       type json = Zulip_types.json

     

       17
       17
       -
       type 'a parser = json -> ('a, Zulip_types.zerror) result

     

       18
       18
       -
       

     

       19
       19
       -
       (** {1 Binding Operators} *)

     

       20
       20
       -
       

     

       21
       21
       -
       (** Monadic bind operator for sequential parsing with error handling *)

     

       22
       22
       -
       val ( let* ) : ('a, 'e) result -> ('a -> ('b, 'e) result) -> ('b, 'e) result

     

       23
       23
       -
       

     

       24
       24
       -
       (** Map operator for transforming successful results *)

     

       25
       25
       -
       val ( let+ ) : ('a, 'e) result -> ('a -> 'b) -> ('b, 'e) result

     

       26
       26
       -
       

     

       27
       27
       -
       (** Applicative parallel composition for independent field extraction *)

     

       28
       28
       -
       val ( and+ ) : ('a, 'e) result -> ('b, 'e) result -> ('a * 'b, 'e) result

     

       29
       29
       -
       val ( and++ ) : ('a * 'b, 'e) result -> ('c, 'e) result -> ('a * 'b * 'c, 'e) result

     

       30
       30
       -
       val ( and+++ ) : ('a * 'b * 'c, 'e) result -> ('d, 'e) result -> ('a * 'b * 'c * 'd, 'e) result

     

       31
       31
       -
       val ( and++++ ) : ('a * 'b * 'c * 'd, 'e) result -> ('f, 'e) result -> ('a * 'b * 'c * 'd * 'f, 'e) result

     

       32
       32
       -
       

     

       33
       33
       -
       (** {1 Alternative and Default Operators} *)

     

       34
       34
       -
       

     

       35
       35
       -
       (** Alternative operator - try first parser, if fails try second *)

     

       36
       36
       -
       val ( <|> ) : ('a, 'e) result -> ('a, 'e) result -> ('a, 'e) result

     

       37
       37
       -
       

     

       38
       38
       -
       (** Provide a default value if parsing fails *)

     

       39
       39
       -
       val ( |? ) : ('a, 'e) result -> 'a -> 'a

     

       40
       40
       -
       

     

       41
       41
       -
       (** {1 Field Extraction} *)

     

       42
       42
       -
       

     

       43
       43
       -
       (** Parse a required field with a custom parser *)

     

       44
       44
       -
       val field : (string * json) list -> string -> 'a parser -> ('a, Zulip_types.zerror) result

     

       45
       45
       -
       

     

       46
       46
       -
       (** Parse an optional field with a custom parser *)

     

       47
       47
       -
       val field_opt : (string * json) list -> string -> 'a parser -> ('a option, Zulip_types.zerror) result

     

       48
       48
       -
       

     

       49
       49
       -
       (** Parse a field with a default value if missing or fails *)

     

       50
       50
       -
       val field_or : (string * json) list -> string -> 'a parser -> 'a -> ('a, Zulip_types.zerror) result

     

       51
       51
       -
       

     

       52
       52
       -
       (** {1 Basic Parsers} *)

     

       53
       53
       -
       

     

       54
       54
       -
       (** Parse a JSON string *)

     

       55
       55
       -
       val string : string parser

     

       56
       56
       -
       

     

       57
       57
       -
       (** Parse a JSON number as integer (handles both int and float) *)

     

       58
       58
       -
       val int : int parser

     

       59
       59
       -
       

     

       60
       60
       -
       (** Parse a JSON number as float *)

     

       61
       61
       -
       val float : float parser

     

       62
       62
       -
       

     

       63
       63
       -
       (** Parse a JSON boolean *)

     

       64
       64
       -
       val bool : bool parser

     

       65
       65
       -
       

     

       66
       66
       -
       (** Parse a JSON array with a parser for elements *)

     

       67
       67
       -
       val array : 'a parser -> 'a list parser

     

       68
       68
       -
       

     

       69
       69
       -
       (** Parse a JSON object to get its fields *)

     

       70
       70
       -
       val object_ : json -> ((string * json) list, Zulip_types.zerror) result

     

       71
       71
       -
       

     

       72
       72
       -
       (** {1 Utility Functions} *)

     

       73
       73
       -
       

     

       74
       74
       -
       (** Convert option to result with error message *)

     

       75
       75
       -
       val required : string -> 'a option -> ('a, Zulip_types.zerror) result

     

       76
       76
       -
       

     

       77
       77
       -
       (** Get value from option with default *)

     

       78
       78
       -
       val default : 'a -> 'a option -> 'a

     

       79
       79
       -
       

     

       80
       80
       -
       (** Lift a pure value into parser context *)

     

       81
       81
       -
       val pure : 'a -> ('a, 'e) result

     

       82
       82
       -
       

     

       83
       83
       -
       (** Fail with an error message *)

     

       84
       84
       -
       val fail : string -> ('a, Zulip_types.zerror) result

     

       85
       85
       -
       

     

       86
       86
       -
       (** Map over a list with error handling *)

     

       87
       87
       -
       val traverse : ('a -> ('b, Zulip_types.zerror) result) -> 'a list -> ('b list, Zulip_types.zerror) result

     

       88
       88
       -
       

     

       89
       89
       -
       (** Filter and map over a list, dropping errors *)

     

       90
       90
       -
       val filter_map : ('a -> ('b, Zulip_types.zerror) result) -> 'a list -> 'b list

     

       91
       91
       -
       

     

       92
       92
       -
       (** Run a parser on JSON *)

     

       93
       93
       -
       val parse : 'a parser -> json -> ('a, Zulip_types.zerror) result

     

       94
       94
       -
       

     

       95
       95
       -
       (** Run a parser with error context *)

     

       96
       96
       -
       val with_context : string -> 'a parser -> 'a parser

+35 -21

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

···

       19
       19
        
       let local_id t = t.local_id

     

       20
       20
        
       let read_by_sender t = t.read_by_sender

     

       21
       21
        
       

     

       22
       22
       -
       let to_json t =

     

       23
       23
       -
         let base_fields = [

     

       24
       24
       -
           ("type", `String (Message_type.to_string t.type_));

     

       25
       25
       -
           ("to", `A (List.map (fun s -> `String s) t.to_));

     

       26
       26
       -
           ("content", `String t.content);

     

       27
       27
       -
           ("read_by_sender", `Bool t.read_by_sender);

     

       28
       28
       -
         ] in

     

       29
       29
       -
         let with_topic = match t.topic with

     

       30
       30
       -
           | Some topic -> ("topic", `String topic) :: base_fields

     

       31
       31
       -
           | None -> base_fields in

     

       32
       32
       -
         let with_queue_id = match t.queue_id with

     

       33
       33
       -
           | Some qid -> ("queue_id", `String qid) :: with_topic

     

       34
       34
       -
           | None -> with_topic in

     

       35
       35
       -
         let with_local_id = match t.local_id with

     

       36
       36
       -
           | Some lid -> ("local_id", `String lid) :: with_queue_id

     

       37
       37
       -
           | None -> with_queue_id in

     

       38
       38
       -
         `O with_local_id

     

       22
       22
       +
       let pp fmt t = Format.fprintf fmt "Message{type=%a, to=%s, content=%s}"

     

       23
       23
       +
         Message_type.pp t.type_

     

       24
       24
       +
         (String.concat "," t.to_)

     

       25
       25
       +
         t.content

     

       39
       26
        
       

     

       40
       40
       -
       let pp fmt t = Format.fprintf fmt "Message{type=%a, to=%s, content=%s}" 

     

       41
       41
       -
         Message_type.pp t.type_ 

     

       42
       42
       -
         (String.concat "," t.to_) 

     

       43
       43
       -
         t.content
     

       27
       27
       +
       (* Jsont codec for Message_type.t *)

     

       28
       28
       +
       let message_type_jsont =

     

       29
       29
       +
         let of_string s = match Message_type.of_string s with

     

       30
       30
       +
           | Some t -> Ok t

     

       31
       31
       +
           | None -> Error (Format.sprintf "Invalid message type: %s" s)

     

       32
       32
       +
         in

     

       33
       33
       +
         Jsont.of_of_string ~kind:"Message_type.t" of_string ~enc:Message_type.to_string

     

       34
       34
       +
       

     

       35
       35
       +
       (* Jsont codec for the message *)

     

       36
       36
       +
       let jsont =

     

       37
       37
       +
         let kind = "Message" in

     

       38
       38
       +
         let doc = "A Zulip message to be sent" in

     

       39
       39
       +
         let make type_ to_ content topic queue_id local_id read_by_sender =

     

       40
       40
       +
           { type_; to_; content; topic; queue_id; local_id; read_by_sender }

     

       41
       41
       +
         in

     

       42
       42
       +
         Jsont.Object.map ~kind ~doc make

     

       43
       43
       +
         |> Jsont.Object.mem "type" message_type_jsont ~enc:type_

     

       44
       44
       +
         |> Jsont.Object.mem "to" (Jsont.list Jsont.string) ~enc:to_

     

       45
       45
       +
         |> Jsont.Object.mem "content" Jsont.string ~enc:content

     

       46
       46
       +
         |> Jsont.Object.opt_mem "topic" Jsont.string ~enc:topic

     

       47
       47
       +
         |> Jsont.Object.opt_mem "queue_id" Jsont.string ~enc:queue_id

     

       48
       48
       +
         |> Jsont.Object.opt_mem "local_id" Jsont.string ~enc:local_id

     

       49
       49
       +
         |> Jsont.Object.mem "read_by_sender" Jsont.bool ~enc:read_by_sender

     

       50
       50
       +
         |> Jsont.Object.finish

     

       51
       51
       +
       

     

       52
       52
       +
       (* Encoding functions *)

     

       53
       53
       +
       let to_json_string t =

     

       54
       54
       +
         Encode.to_json_string jsont t

     

       55
       55
       +
       

     

       56
       56
       +
       let to_form_urlencoded t =

     

       57
       57
       +
         Encode.to_form_urlencoded jsont t

+18 -9

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

···

       1
       1
        
       type t

     

       2
       2
        
       

     

       3
       3
       -
       val create : 

     

       4
       4
       -
         type_:Message_type.t -> 

     

       5
       5
       -
         to_:string list -> 

     

       6
       6
       -
         content:string -> 

     

       7
       7
       -
         ?topic:string -> 

     

       8
       8
       -
         ?queue_id:string -> 

     

       9
       9
       -
         ?local_id:string -> 

     

       10
       10
       -
         ?read_by_sender:bool -> 

     

       3
       3
       +
       val create :

     

       4
       4
       +
         type_:Message_type.t ->

     

       5
       5
       +
         to_:string list ->

     

       6
       6
       +
         content:string ->

     

       7
       7
       +
         ?topic:string ->

     

       8
       8
       +
         ?queue_id:string ->

     

       9
       9
       +
         ?local_id:string ->

     

       10
       10
       +
         ?read_by_sender:bool ->

     

       11
       11
        
         unit -> t

     

       12
       12
        
       

     

       13
       13
        
       val type_ : t -> Message_type.t

     
···

       17
       17
        
       val queue_id : t -> string option

     

       18
       18
        
       val local_id : t -> string option

     

       19
       19
        
       val read_by_sender : t -> bool

     

       20
       20
       -
       val to_json : t -> Zulip_types.json

     

       20
       20
       +
       

     

       21
       21
       +
       (** Jsont codec for the message type *)

     

       22
       22
       +
       val jsont : t Jsont.t

     

       23
       23
       +
       

     

       24
       24
       +
       (** Encode to JSON string *)

     

       25
       25
       +
       val to_json_string : t -> string

     

       26
       26
       +
       

     

       27
       27
       +
       (** Encode to form-urlencoded string *)

     

       28
       28
       +
       val to_form_urlencoded : t -> string

     

       29
       29
       +
       

     

       21
       30
        
       val pp : Format.formatter -> t -> unit

+20 -8

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

···

       6
       6
        
       let id t = t.id

     

       7
       7
        
       let automatic_new_visibility_policy t = t.automatic_new_visibility_policy

     

       8
       8
        
       

     

       9
       9
       +
       let pp fmt t = Format.fprintf fmt "MessageResponse{id=%d}" t.id

     

       10
       10
       +
       

     

       11
       11
       +
       (* Jsont codec for message response *)

     

       12
       12
       +
       let jsont =

     

       13
       13
       +
         let kind = "MessageResponse" in

     

       14
       14
       +
         let doc = "A Zulip message response" in

     

       15
       15
       +
         let make id automatic_new_visibility_policy =

     

       16
       16
       +
           { id; automatic_new_visibility_policy }

     

       17
       17
       +
         in

     

       18
       18
       +
         Jsont.Object.map ~kind ~doc make

     

       19
       19
       +
         |> Jsont.Object.mem "id" Jsont.int ~enc:id

     

       20
       20
       +
         |> Jsont.Object.opt_mem "automatic_new_visibility_policy" Jsont.string ~enc:automatic_new_visibility_policy

     

       21
       21
       +
         |> Jsont.Object.finish

     

       22
       22
       +
       

     

       23
       23
       +
       (* Decode and encode functions using Encode module *)

     

       9
       24
        
       let of_json json =

     

       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

     

       15
       15
       -
               Ok { id; automatic_new_visibility_policy }

     

       16
       16
       -
         ) json

     

       25
       25
       +
         match Encode.from_json jsont json with

     

       26
       26
       +
         | Ok v -> Ok v

     

       27
       27
       +
         | Error msg -> Error (Zulip_types.create_error ~code:(Other "json_parse_error") ~msg ())

     

       17
       28
        
       

     

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

       29
       29
       +
       let to_json_string t =

     

       30
       30
       +
         Encode.to_json_string jsont t

stack/zulip/lib/zulip/lib/message_response.mli

···

       2
       2
        
       

     

       3
       3
        
       val id : t -> int

     

       4
       4
        
       val automatic_new_visibility_policy : t -> string option

     

       5
       5
       +
       

     

       6
       6
       +
       (** Jsont codec for message response *)

     

       7
       7
       +
       val jsont : t Jsont.t

     

       8
       8
       +
       

     

       5
       9
        
       val of_json : Zulip_types.json -> (t, Zulip_types.zerror) result

     

       10
       10
       +
       val to_json_string : t -> string

     

       6
       11
        
       val pp : Format.formatter -> t -> unit

+15 -62

stack/zulip/lib/zulip/lib/messages.ml

···

       1
       1
        
       let send client message =

     

       2
       2
       -
         let json = Message.to_json message in

     

       3
       3
       -
         let params = match json with

     

       4
       4
       -
           | `O fields ->

     

       5
       5
       -
               List.fold_left (fun acc (key, value) ->

     

       6
       6
       -
                 let str_value = match value with

     

       7
       7
       -
                   | `String s -> s

     

       8
       8
       -
                   | `Bool true -> "true"

     

       9
       9
       -
                   | `Bool false -> "false"

     

       10
       10
       -
                   | `A arr -> String.concat "," (List.map (function `String s -> s | _ -> "") arr)

     

       11
       11
       -
                   | _ -> ""

     

       12
       12
       -
                 in

     

       13
       13
       -
                 (key, str_value) :: acc

     

       14
       14
       -
               ) [] fields

     

       15
       15
       -
           | _ -> [] in

     

       16
       16
       -
         

     

       17
       17
       -
         match Client.request client ~method_:`POST ~path:"/api/v1/messages" ~params () with

     

       2
       2
       +
         (* Use form-urlencoded encoding for the message *)

     

       3
       3
       +
         let body = Message.to_form_urlencoded message in

     

       4
       4
       +
         let content_type = "application/x-www-form-urlencoded" in

     

       5
       5
       +
       

     

       6
       6
       +
         match Client.request client ~method_:`POST ~path:"/api/v1/messages" ~body ~content_type () with

     

       18
       7
        
         | Ok response -> Message_response.of_json response

     

       19
       8
        
         | Error err -> Error err

     

       20
       9
        
       

     

       21
       10
        
       let edit client ~message_id ?content ?topic () =

     

       22
       22
       -
         let params = 

     

       11
       11
       +
         let params =

     

       23
       12
        
           (("message_id", string_of_int message_id) ::

     

       24
       13
        
            (match content with Some c -> [("content", c)] | None -> []) @

     

       25
       14
        
            (match topic with Some t -> [("topic", t)] | None -> [])) in

     

       26
       26
       -
         

     

       15
       15
       +
       

     

       27
       16
        
         match Client.request client ~method_:`PATCH ~path:("/api/v1/messages/" ^ string_of_int message_id) ~params () with

     

       28
       17
        
         | Ok _ -> Ok ()

     

       29
       18
        
         | Error err -> Error err

     
···

       48
       37
        
       let add_reaction client ~message_id ~emoji_name =

     

       49
       38
        
         let params = [

     

       50
       39
        
           ("emoji_name", emoji_name);

     

       51
       51
       -
           ("reaction_type", "unicode_emoji");

     

       52
       40
        
         ] in

     

       53
       41
        
         match Client.request client ~method_:`POST

     

       54
       54
       -
           ~path:("/api/v1/messages/" ^ string_of_int message_id ^ "/reactions")

     

       55
       55
       -
           ~params () with

     

       56
       56
       -
         | Ok _ -> Ok ()

     

       42
       42
       +
                 ~path:("/api/v1/messages/" ^ string_of_int message_id ^ "/reactions") ~params () with

     

       43
       43
       +
         | Ok _json -> Ok ()

     

       57
       44
        
         | Error err -> Error err

     

       58
       45
        
       

     

       59
       46
        
       let remove_reaction client ~message_id ~emoji_name =

     

       60
       47
        
         let params = [

     

       61
       48
        
           ("emoji_name", emoji_name);

     

       62
       62
       -
           ("reaction_type", "unicode_emoji");

     

       63
       49
        
         ] in

     

       64
       50
        
         match Client.request client ~method_:`DELETE

     

       65
       65
       -
           ~path:("/api/v1/messages/" ^ string_of_int message_id ^ "/reactions")

     

       66
       66
       -
           ~params () with

     

       67
       67
       -
         | Ok _ -> Ok ()

     

       51
       51
       +
                 ~path:("/api/v1/messages/" ^ string_of_int message_id ^ "/reactions") ~params () with

     

       52
       52
       +
         | Ok _json -> Ok ()

     

       68
       53
        
         | Error err -> Error err

     

       69
       54
        
       

     

       70
       70
       -
       let upload_file client ~filename =

     

       71
       71
       -
         (* Read file contents *)

     

       72
       72
       -
         let ic = open_in_bin filename in

     

       73
       73
       -
         let len = in_channel_length ic in

     

       74
       74
       -
         let content = really_input_string ic len in

     

       75
       75
       -
         close_in ic;

     

       76
       76
       -
       

     

       77
       77
       -
         (* Extract just the filename from the path *)

     

       78
       78
       -
         let basename = Filename.basename filename in

     

       79
       79
       -
       

     

       80
       80
       -
         (* Create multipart form data boundary *)

     

       81
       81
       -
         let boundary = "----OCamlZulipBoundary" ^ string_of_float (Unix.gettimeofday ()) in

     

       82
       82
       -
       

     

       83
       83
       -
         (* Build multipart body *)

     

       84
       84
       -
         let body = Buffer.create (len + 1024) in

     

       85
       85
       -
         Buffer.add_string body ("--" ^ boundary ^ "\r\n");

     

       86
       86
       -
         Buffer.add_string body ("Content-Disposition: form-data; name=\"file\"; filename=\"" ^ basename ^ "\"\r\n");

     

       87
       87
       -
         Buffer.add_string body "Content-Type: application/octet-stream\r\n";

     

       88
       88
       -
         Buffer.add_string body "\r\n";

     

       89
       89
       -
         Buffer.add_string body content;

     

       90
       90
       -
         Buffer.add_string body ("\r\n--" ^ boundary ^ "--\r\n");

     

       91
       91
       -
       

     

       92
       92
       -
         let body_str = Buffer.contents body in

     

       93
       93
       -
         let content_type = "multipart/form-data; boundary=" ^ boundary in

     

       94
       94
       -
       

     

       95
       95
       -
         match Client.request client ~method_:`POST ~path:"/api/v1/user_uploads"

     

       96
       96
       -
           ~body:body_str ~content_type () with

     

       97
       97
       -
         | Ok json ->

     

       98
       98
       -
             (* Parse response to extract URI *)

     

       99
       99
       -
             (match json with

     

       100
       100
       -
              | `O fields ->

     

       101
       101
       -
                  (match Jsonu.get_string fields "uri" with

     

       102
       102
       -
                   | Ok uri -> Ok uri

     

       103
       103
       -
                   | Error e -> Error e)

     

       104
       104
       -
              | _ -> Error (Zulip_types.create_error ~code:(Zulip_types.Other "upload_error") ~msg:"Failed to parse upload response" ()))

     

       105
       105
       -
         | Error err -> Error err
     

       55
       55
       +
       let upload_file _client ~filename:_ =

     

       56
       56
       +
         (* TODO: Implement file upload using multipart/form-data *)

     

       57
       57
       +
         Error (Zulip_types.create_error ~code:(Other "not_implemented")

     

       58
       58
       +
           ~msg:"File upload not yet implemented" ())

+25 -18

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

···

       15
       15
        
       let is_admin t = t.is_admin

     

       16
       16
        
       let is_bot t = t.is_bot

     

       17
       17
        
       

     

       18
       18
       -
       let to_json t = 

     

       19
       19
       -
         `O [

     

       20
       20
       -
           ("email", `String t.email);

     

       21
       21
       -
           ("full_name", `String t.full_name);

     

       22
       22
       -
           ("is_active", `Bool t.is_active);

     

       23
       23
       -
           ("is_admin", `Bool t.is_admin);

     

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

     

       25
       25
       -
         ]

     

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

     

       19
       19
       +
       

     

       20
       20
       +
       (* Jsont codec for user *)

     

       21
       21
       +
       let jsont =

     

       22
       22
       +
         let kind = "User" in

     

       23
       23
       +
         let doc = "A Zulip user" in

     

       24
       24
       +
         let make email full_name is_active is_admin is_bot =

     

       25
       25
       +
           { email; full_name; is_active; is_admin; is_bot }

     

       26
       26
       +
         in

     

       27
       27
       +
         Jsont.Object.map ~kind ~doc make

     

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

     

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

     

       30
       30
       +
         |> Jsont.Object.mem "is_active" Jsont.bool ~enc:is_active

     

       31
       31
       +
         |> Jsont.Object.mem "is_admin" Jsont.bool ~enc:is_admin

     

       32
       32
       +
         |> Jsont.Object.mem "is_bot" Jsont.bool ~enc:is_bot

     

       33
       33
       +
         |> Jsont.Object.finish

     

       26
       34
        
       

     

       35
       35
       +
       (* Decode and encode functions using Encode module *)

     

       27
       36
        
       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

     

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

     

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

     

       36
       36
       -
         ) json

     

       37
       37
       +
         match Encode.from_json jsont json with

     

       38
       38
       +
         | Ok v -> Ok v

     

       39
       39
       +
         | Error msg -> Error (Zulip_types.create_error ~code:(Other "json_parse_error") ~msg ())

     

       40
       40
       +
       

     

       41
       41
       +
       let to_json_string t =

     

       42
       42
       +
         Encode.to_json_string jsont t

     

       37
       43
        
       

     

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

       44
       44
       +
       let to_form_urlencoded t =

     

       45
       45
       +
         Encode.to_form_urlencoded jsont t

+18 -7

stack/zulip/lib/zulip/lib/user.mli

···

       1
       1
        
       type t

     

       2
       2
        
       

     

       3
       3
       -
       val create : 

     

       4
       4
       -
         email:string -> 

     

       5
       5
       -
         full_name:string -> 

     

       6
       6
       -
         ?is_active:bool -> 

     

       7
       7
       -
         ?is_admin:bool -> 

     

       8
       8
       -
         ?is_bot:bool -> 

     

       3
       3
       +
       val create :

     

       4
       4
       +
         email:string ->

     

       5
       5
       +
         full_name:string ->

     

       6
       6
       +
         ?is_active:bool ->

     

       7
       7
       +
         ?is_admin:bool ->

     

       8
       8
       +
         ?is_bot:bool ->

     

       9
       9
        
         unit -> t

     

       10
       10
        
       

     

       11
       11
        
       val email : t -> string

     
···

       13
       13
        
       val is_active : t -> bool

     

       14
       14
        
       val is_admin : t -> bool

     

       15
       15
        
       val is_bot : t -> bool

     

       16
       16
       -
       val to_json : t -> Zulip_types.json

     

       16
       16
       +
       

     

       17
       17
       +
       (** Jsont codec for the user type *)

     

       18
       18
       +
       val jsont : t Jsont.t

     

       19
       19
       +
       

     

       20
       20
       +
       (** Decode from Jsont.json *)

     

       17
       21
        
       val of_json : Zulip_types.json -> (t, Zulip_types.zerror) result

     

       22
       22
       +
       

     

       23
       23
       +
       (** Encode to JSON string *)

     

       24
       24
       +
       val to_json_string : t -> string

     

       25
       25
       +
       

     

       26
       26
       +
       (** Encode to form-urlencoded string *)

     

       27
       27
       +
       val to_form_urlencoded : t -> string

     

       28
       28
       +
       

     

       18
       29
        
       val pp : Format.formatter -> t -> unit

+32 -28

stack/zulip/lib/zulip/lib/users.ml

···

       1
       1
       -
       let list client = 

     

       1
       1
       +
       let list client =

     

       2
       2
       +
         (* Define response codec *)

     

       3
       3
       +
         let response_codec =

     

       4
       4
       +
           Jsont.Object.(

     

       5
       5
       +
             map ~kind:"UsersResponse" (fun members -> members)

     

       6
       6
       +
             |> mem "members" (Jsont.list User.jsont) ~enc:(fun x -> x)

     

       7
       7
       +
             |> finish

     

       8
       8
       +
           )

     

       9
       9
       +
         in

     

       10
       10
       +
       

     

       2
       11
        
         match Client.request client ~method_:`GET ~path:"/api/v1/users" () with

     

       3
       3
       -
         | Ok json -> 

     

       4
       4
       -
             (match json with

     

       5
       5
       -
              | `O fields ->

     

       6
       6
       -
                  (match List.assoc_opt "members" fields with

     

       7
       7
       -
                   | Some (`A user_list) ->

     

       8
       8
       -
                       let users = List.fold_left (fun acc user_json ->

     

       9
       9
       -
                         match User.of_json user_json with

     

       10
       10
       -
                         | Ok user -> user :: acc

     

       11
       11
       -
                         | Error _ -> acc

     

       12
       12
       -
                       ) [] user_list in

     

       13
       13
       -
                       Ok (List.rev users)

     

       14
       14
       -
                   | _ -> Error (Zulip_types.create_error ~code:(Other "api_error") ~msg:"Invalid users response format" ()))

     

       15
       15
       -
              | _ -> Error (Zulip_types.create_error ~code:(Other "api_error") ~msg:"Users response must be an object" ()))

     

       12
       12
       +
         | Ok json ->

     

       13
       13
       +
             (match Encode.from_json response_codec json with

     

       14
       14
       +
              | Ok users -> Ok users

     

       15
       15
       +
              | Error msg -> Error (Zulip_types.create_error ~code:(Other "api_error") ~msg ()))

     

       16
       16
        
         | Error err -> Error err

     

       17
       17
        
       

     

       18
       18
        
       let get client ~email = 

     
···

       23
       23
        
              | Error err -> Error err)

     

       24
       24
        
         | Error err -> Error err

     

       25
       25
        
       

     

       26
       26
       -
       let create_user client ~email ~full_name = 

     

       27
       27
       -
         let body_json = `O [

     

       28
       28
       -
           ("email", `String email);

     

       29
       29
       -
           ("full_name", `String full_name);

     

       30
       30
       -
         ] in

     

       31
       31
       -
         let body = match body_json with

     

       32
       32
       -
           | `O fields -> 

     

       33
       33
       -
               String.concat "&" (List.map (fun (k, v) -> 

     

       34
       34
       -
                 match v with 

     

       35
       35
       -
                 | `String s -> k ^ "=" ^ s 

     

       36
       36
       -
                 | _ -> ""

     

       37
       37
       -
               ) fields)

     

       38
       38
       -
           | _ -> "" in

     

       39
       39
       -
         match Client.request client ~method_:`POST ~path:"/api/v1/users" ~body () with

     

       26
       26
       +
       (* Request type for create_user *)

     

       27
       27
       +
       module Create_user_request = struct

     

       28
       28
       +
         type t = { email : string; full_name : string }

     

       29
       29
       +
       

     

       30
       30
       +
         let codec =

     

       31
       31
       +
           Jsont.Object.(

     

       32
       32
       +
             map ~kind:"CreateUserRequest" (fun email full_name -> { email; full_name })

     

       33
       33
       +
             |> mem "email" Jsont.string ~enc:(fun r -> r.email)

     

       34
       34
       +
             |> mem "full_name" Jsont.string ~enc:(fun r -> r.full_name)

     

       35
       35
       +
             |> finish

     

       36
       36
       +
           )

     

       37
       37
       +
       end

     

       38
       38
       +
       

     

       39
       39
       +
       let create_user client ~email ~full_name =

     

       40
       40
       +
         let req = Create_user_request.{ email; full_name } in

     

       41
       41
       +
         let body = Encode.to_form_urlencoded Create_user_request.codec req in

     

       42
       42
       +
         let content_type = "application/x-www-form-urlencoded" in

     

       43
       43
       +
         match Client.request client ~method_:`POST ~path:"/api/v1/users" ~body ~content_type () with

     

       40
       44
        
         | Ok _json -> Ok ()

     

       41
       45
        
         | Error err -> Error err

     

       42
       46

+1 -5

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

···

       41
       41
        
       module Event = Event

     

       42
       42
        
       module Event_type = Event_type

     

       43
       43
        
       module Event_queue = Event_queue

     

       44
       44
       -
       

     

       45
       45
       -
       (** JSON utilities with short alias *)

     

       46
       46
       -
       module J = Jsonu

     

       47
       47
       -
       module Jsonu_syntax = Jsonu_syntax

     

       48
       48
       -
       module Jsonu = Jsonu
     

       44
       44
       +
       module Encode = Encode

+2 -10

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

···

       65
       65
        
       module Event_type = Event_type

     

       66
       66
        
       module Event_queue = Event_queue

     

       67
       67
        
       

     

       68
       68
       -
       (** {1 JSON Utilities} *)

     

       69
       69
       -
       

     

       70
       70
       -
       (** JSON utility functions (abbreviated as J for convenience) *)

     

       71
       71
       -
       module J = Jsonu

     

       72
       72
       -
       

     

       73
       73
       -
       (** JSON parsing syntax extensions *)

     

       74
       74
       -
       module Jsonu_syntax = Jsonu_syntax

     

       75
       75
       -
       

     

       76
       76
       -
       (** Full JSON utilities module *)

     

       77
       77
       -
       module Jsonu = Jsonu

     

       68
       68
       +
       (** JSON encoding/decoding utilities *)

     

       69
       69
       +
       module Encode = Encode

     

       78
       70

+32 -15

stack/zulip/lib/zulip/lib/zulip_types.ml

···

       1
       1
        
       (** Core types for Zulip API *)

     

       2
       2
        
       

     

       3
       3
        
       (** JSON type used throughout the API *)

     

       4
       4
       -
       type json = [`Null | `Bool of bool | `Float of float | `String of string | `A of json list | `O of (string * json) list]

     

       4
       4
       +
       type json = Jsont.json

     

       5
       5
        
       

     

       6
       6
        
       (** Error codes returned by Zulip API *)

     

       7
       7
        
       type error_code =

     
···

       45
       45
        
       let pp_error fmt t = Format.fprintf fmt "Error(%s): %s"

     

       46
       46
        
         (error_code_to_string t.code) t.message

     

       47
       47
        
       

     

       48
       48
       +
       (* Jsont codec for error_code *)

     

       49
       49
       +
       let error_code_jsont =

     

       50
       50
       +
         let of_string s = Ok (error_code_of_string s) in

     

       51
       51
       +
         Jsont.of_of_string ~kind:"ErrorCode" of_string ~enc:error_code_to_string

     

       52
       52
       +
       

     

       53
       53
       +
       (* Jsont codec for zerror *)

     

       54
       54
       +
       let zerror_jsont =

     

       55
       55
       +
         let kind = "ZulipError" in

     

       56
       56
       +
         let make code msg =

     

       57
       57
       +
           (* Extra fields handled by keep_unknown - we'll extract them separately *)

     

       58
       58
       +
           { code = error_code_of_string code; message = msg; extra = [] }

     

       59
       59
       +
         in

     

       60
       60
       +
         let code t = error_code_to_string t.code in

     

       61
       61
       +
         let msg t = t.message in

     

       62
       62
       +
         Jsont.Object.(

     

       63
       63
       +
           map ~kind make

     

       64
       64
       +
           |> mem "code" Jsont.string ~enc:code

     

       65
       65
       +
           |> mem "msg" Jsont.string ~enc:msg

     

       66
       66
       +
           |> finish

     

       67
       67
       +
         )

     

       68
       68
       +
       

     

       48
       69
        
       let error_of_json json =

     

       49
       49
       -
         match json with

     

       50
       50
       -
         | `O fields ->

     

       51
       51
       -
             (try

     

       52
       52
       -
               let code_str = match List.assoc "code" fields with

     

       53
       53
       -
                 | `String s -> s

     

       54
       54
       -
                 | _ -> "OTHER" in

     

       55
       55
       -
               let msg = match List.assoc "msg" fields with

     

       56
       56
       -
                 | `String s -> s

     

       57
       57
       -
                 | _ -> "Unknown error" in

     

       58
       58
       -
               let code = error_code_of_string code_str in

     

       59
       59
       -
               let extra = List.filter (fun (k, _) -> k <> "code" && k <> "msg" && k <> "result") fields in

     

       60
       60
       -
               Some (create_error ~code ~msg ~extra ())

     

       61
       61
       -
             with Not_found -> None)

     

       62
       62
       -
         | _ -> None
     

       70
       70
       +
         match Encode.from_json zerror_jsont json with

     

       71
       71
       +
         | Ok err ->

     

       72
       72
       +
             (* Extract extra fields by getting all fields except code, msg, result *)

     

       73
       73
       +
             (match json with

     

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

     

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

     

       76
       76
       +
                  let extra = List.filter (fun (k, _) -> k <> "code" && k <> "msg" && k <> "result") assoc in

     

       77
       77
       +
                  Some { err with extra }

     

       78
       78
       +
              | _ -> Some err)

     

       79
       79
       +
         | Error _ -> None

+6 -1

stack/zulip/lib/zulip/lib/zulip_types.mli

···

       1
       1
        
       (** Core types for Zulip API *)

     

       2
       2
        
       

     

       3
       3
        
       (** JSON type used throughout the API *)

     

       4
       4
       -
       type json = [`Null | `Bool of bool | `Float of float | `String of string | `A of json list | `O of (string * json) list]

     

       4
       4
       +
       type json = Jsont.json

     

       5
       5
        
       

     

       6
       6
        
       (** Error codes returned by Zulip API *)

     

       7
       7
        
       type error_code =

     
···

       27
       27
        
       val error_message : zerror -> string

     

       28
       28
        
       val error_extra : zerror -> (string * json) list

     

       29
       29
        
       val pp_error : Format.formatter -> zerror -> unit

     

       30
       30
       +
       

     

       31
       31
       +
       (** Jsont codecs *)

     

       32
       32
       +
       val error_code_jsont : error_code Jsont.t

     

       33
       33
       +
       val zerror_jsont : zerror Jsont.t

     

       34
       34
       +
       

     

       30
       35
        
       val error_of_json : json -> zerror option

+6 -5

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

···

       45
       45
        
             (* Extract the actual message from the event *)

     

       46
       46
        
             let message_json, flags =

     

       47
       47
        
               match event_data with

     

       48
       48
       -
               | `O fields ->

     

       49
       49
       -
                   let msg = match List.assoc_opt "message" fields with

     

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

     

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

     

       50
       50
       +
                   let msg = match List.assoc_opt "message" assoc with

     

       50
       51
        
                     | Some m -> m

     

       51
       52
        
                     | None -> event_data (* Fallback if structure is different *)

     

       52
       53
        
                   in

     

       53
       53
       -
                   let flgs = match List.assoc_opt "flags" fields with

     

       54
       54
       -
                     | Some (`A f) -> f

     

       54
       54
       +
                   let flgs = match List.assoc_opt "flags" assoc with

     

       55
       55
       +
                     | Some (Jsont.Array (f, _)) -> f

     

       55
       56
        
                     | _ -> []

     

       56
       57
        
                   in

     

       57
       58
        
                   (msg, flgs)

     
···

       73
       74
        
       

     

       74
       75
        
                  (* Check if mentioned *)

     

       75
       76
        
                  let is_mentioned =

     

       76
       76
       -
                    List.exists (function `String "mentioned" -> true | _ -> false) flags ||

     

       77
       77
       +
                    List.exists (function Jsont.String ("mentioned", _) -> true | _ -> false) flags ||

     

       77
       78
        
                    Message.is_mentioned message ~user_email:bot_email in

     

       78
       79
        
       

     

       79
       80
        
                  (* Check if it's a private message *)

+81 -29

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

···

       9
       9
        
         mutable dirty_keys : string list;

     

       10
       10
        
       }

     

       11
       11
        
       

     

       12
       12
       +
       (** {1 JSON Codecs for Bot Storage} *)

     

       13
       13
       +
       

     

       14
       14
       +
       (* Storage response type - {"storage": {...}} *)

     

       15
       15
       +
       type storage_response = {

     

       16
       16
       +
         storage : (string * string) list;

     

       17
       17
       +
         unknown : Jsont.json;  (** Unknown/extra JSON fields preserved during parsing *)

     

       18
       18
       +
       }

     

       19
       19
       +
       

     

       20
       20
       +
       (* Custom codec for storage_response that handles the dictionary *)

     

       21
       21
       +
       let storage_response_jsont : storage_response Jsont.t =

     

       22
       22
       +
         let of_string s =

     

       23
       23
       +
           match Jsont_bytesrw.decode_string' Jsont.json s with

     

       24
       24
       +
           | Error _ -> Error "Failed to decode JSON"

     

       25
       25
       +
           | Ok json ->

     

       26
       26
       +
               match json with

     

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

     

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

     

       29
       29
       +
                   (match List.assoc_opt "storage" assoc with

     

       30
       30
       +
                    | Some (Jsont.Object (storage_fields, _)) ->

     

       31
       31
       +
                        let storage = List.filter_map (fun ((k, _), v) ->

     

       32
       32
       +
                          match v with

     

       33
       33
       +
                          | Jsont.String (s, _) -> Some (k, s)

     

       34
       34
       +
                          | _ -> None

     

       35
       35
       +
                        ) storage_fields in

     

       36
       36
       +
                        (* Keep unknown fields *)

     

       37
       37
       +
                        let unknown_fields = List.filter (fun (k, _) -> k <> "storage") assoc in

     

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

     

       39
       39
       +
                        let unknown = Jsont.Object (unknown_mems, Jsont.Meta.none) in

     

       40
       40
       +
                        Ok { storage; unknown }

     

       41
       41
       +
                    | Some _ -> Error "Expected 'storage' field to be an object"

     

       42
       42
       +
                    | None -> Ok { storage = []; unknown = Jsont.Object ([], Jsont.Meta.none) })

     

       43
       43
       +
               | _ -> Error "Expected JSON object for storage response"

     

       44
       44
       +
         in

     

       45
       45
       +
         let to_string { storage; unknown } =

     

       46
       46
       +
           (* Create storage object *)

     

       47
       47
       +
           let storage_fields = List.map (fun (k, v) ->

     

       48
       48
       +
             ((k, Jsont.Meta.none), Jsont.String (v, Jsont.Meta.none))

     

       49
       49
       +
           ) storage in

     

       50
       50
       +
           let storage_obj = Jsont.Object (storage_fields, Jsont.Meta.none) in

     

       51
       51
       +
       

     

       52
       52
       +
           (* Merge with unknown fields *)

     

       53
       53
       +
           let storage_mem = (("storage", Jsont.Meta.none), storage_obj) in

     

       54
       54
       +
           let unknown_mems = match unknown with

     

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

     

       56
       56
       +
             | _ -> []

     

       57
       57
       +
           in

     

       58
       58
       +
           let json = Jsont.Object (storage_mem :: unknown_mems, Jsont.Meta.none) in

     

       59
       59
       +
           match Jsont_bytesrw.encode_string' Jsont.json json with

     

       60
       60
       +
           | Ok s -> s

     

       61
       61
       +
           | Error e -> failwith ("Failed to encode storage response: " ^ Jsont.Error.to_string e)

     

       62
       62
       +
         in

     

       63
       63
       +
         Jsont.of_of_string ~kind:"StorageResponse" of_string ~enc:to_string

     

       64
       64
       +
       

     

       12
       65
        
       let create client ~bot_email =

     

       13
       66
        
         Log.info (fun m -> m "Creating bot storage for %s" bot_email);

     

       14
       67
        
         let cache = Hashtbl.create 16 in

     
···

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

     

       20
       73
        
                 () with

     

       21
       74
        
         | Ok json ->

     

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

     

       23
       23
       -
              | Some storage_fields ->

     

       75
       75
       +
             (match Zulip.Encode.from_json storage_response_jsont json with

     

       76
       76
       +
              | Ok response ->

     

       24
       77
        
                  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 -> ())

     

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

     

       79
       79
       +
                    Hashtbl.add cache k v

     

       80
       80
       +
                  ) response.storage

     

       81
       81
       +
              | Error msg ->

     

       82
       82
       +
                  Log.warn (fun m -> m "Failed to parse storage response: %s" msg))

     

       32
       83
        
         | Error e ->

     

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

     

       34
       85
        
       

     
···

       43
       94
        
       let encode_storage_update keys_values =

     

       44
       95
        
         (* Build the storage object as JSON - the API expects storage={"key": "value"} *)

     

       45
       96
        
         let storage_obj =

     

       46
       46
       -
           List.map (fun (k, v) -> (k, `String v)) keys_values

     

       97
       97
       +
           List.map (fun (k, v) -> ((k, Jsont.Meta.none), Jsont.String (v, Jsont.Meta.none))) keys_values

     

       47
       98
        
         in

     

       48
       48
       -
         let json_obj = `O storage_obj in

     

       99
       99
       +
         let json_obj = Jsont.Object (storage_obj, Jsont.Meta.none) in

     

       49
       100
        
       

     

       50
       50
       -
         (* Convert to JSON string using Ezjsonm *)

     

       51
       51
       -
         let json_str = Ezjsonm.to_string json_obj in

     

       101
       101
       +
         (* Convert to JSON string using Jsont_bytesrw *)

     

       102
       102
       +
         let json_str = Jsont_bytesrw.encode_string' Jsont.json json_obj |> Result.get_ok in

     

       52
       103
        
       

     

       53
       104
        
         (* Return as form-encoded body: storage=<url-encoded-json> *)

     

       54
       105
        
         "storage=" ^ Uri.pct_encode json_str

     
···

       68
       119
        
                     ~path:"/api/v1/bot_storage"

     

       69
       120
        
                     ~params () with

     

       70
       121
        
             | Ok json ->

     

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

     

       72
       72
       -
                  | Some storage_fields ->

     

       73
       73
       -
                      (match Zulip.Jsonu.get_string_opt storage_fields key with

     

       122
       122
       +
                 (match Zulip.Encode.from_json storage_response_jsont json with

     

       123
       123
       +
                  | Ok response ->

     

       124
       124
       +
                      (match List.assoc_opt key response.storage with

     

       74
       125
        
                       | Some value ->

     

       75
       126
        
                           (* Cache the value *)

     

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

     
···

       79
       130
        
                       | None ->

     

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

     

       81
       132
        
                           None)

     

       82
       82
       -
                  | None -> None)

     

       133
       133
       +
                  | Error msg ->

     

       134
       134
       +
                      Log.warn (fun m -> m "Failed to parse storage response: %s" msg);

     

       135
       135
       +
                      None)

     

       83
       136
        
             | Error e ->

     

       84
       137
        
                 Log.warn (fun m -> m "Error fetching key %s: %s" key (Zulip.error_message e));

     

       85
       138
        
                 None

     
···

       140
       193
        
                 ~path:"/api/v1/bot_storage"

     

       141
       194
        
                 () with

     

       142
       195
        
         | Ok json ->

     

       143
       143
       -
             (match json with

     

       144
       144
       -
              | `O fields ->

     

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

     

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

     

       147
       147
       -
                       let api_keys = List.map fst storage_fields in

     

       148
       148
       -
                       (* Merge with cache keys *)

     

       149
       149
       -
                       let cache_keys = Hashtbl.fold (fun k _ acc -> k :: acc) t.cache [] in

     

       150
       150
       -
                       let all_keys = List.sort_uniq String.compare (api_keys @ cache_keys) in

     

       151
       151
       -
                       Ok all_keys

     

       152
       152
       -
                   | _ -> Ok [])

     

       153
       153
       -
              | _ -> Ok [])

     

       196
       196
       +
             (match Zulip.Encode.from_json storage_response_jsont json with

     

       197
       197
       +
              | Ok response ->

     

       198
       198
       +
                  let api_keys = List.map fst response.storage in

     

       199
       199
       +
                  (* Merge with cache keys *)

     

       200
       200
       +
                  let cache_keys = Hashtbl.fold (fun k _ acc -> k :: acc) t.cache [] in

     

       201
       201
       +
                  let all_keys = List.sort_uniq String.compare (api_keys @ cache_keys) in

     

       202
       202
       +
                  Ok all_keys

     

       203
       203
       +
              | Error msg ->

     

       204
       204
       +
                  Log.warn (fun m -> m "Failed to parse storage response: %s" msg);

     

       205
       205
       +
                  Ok [])

     

       154
       206
        
         | Error e -> Error e

     

       155
       207
        
       

     

       156
       208
        
       (* Flush all dirty keys to API *)

     
···

       182
       234
        
             | Error e ->

     

       183
       235
        
                 Log.err (fun m -> m "Failed to flush storage: %s" (Zulip.error_message e));

     

       184
       236
        
                 Error e

     

       185
       185
       -
           end
     

       237
       237
       +
           end

+1 -1

stack/zulip/lib/zulip_bot/lib/dune

···

       2
       2
        
        (public_name zulip_bot)

     

       3
       3
        
        (name zulip_bot)

     

       4
       4
        
        (wrapped true)

     

       5
       5
       -
        (libraries zulip unix eio ezjsonm logs mirage-crypto-rng fmt)

     

       5
       5
       +
        (libraries zulip unix eio jsont jsont.bytesrw logs mirage-crypto-rng fmt)

     

       6
       6
        
        (flags (:standard -warn-error -3)))

+277 -88

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

···

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

     

       1
       1
       +
       (* Message parsing using Jsont codecs *)

     

       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)

     
···

       10
       10
        
           email: string;

     

       11
       11
        
           full_name: string;

     

       12
       12
        
           short_name: string option;

     

       13
       13
       +
           unknown: Jsont.json;  (** Unknown/extra JSON fields preserved during parsing *)

     

       13
       14
        
         }

     

       14
       15
        
       

     

       15
       16
        
         let user_id t = t.user_id

     
···

       17
       18
        
         let full_name t = t.full_name

     

       18
       19
        
         let short_name t = t.short_name

     

       19
       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"

     

       64
       64
       +
           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

     

       85
       85
       +
       

     

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

     

       21
       21
       -
           let open Zulip.Jsonu_syntax in

     

       22
       22
       -
           (Zulip.Jsonu.with_object "user" @@ fun fields ->

     

       23
       23
       -
           let* user_id = (field fields "user_id" int) <|> (field fields "id" int) in

     

       24
       24
       -
           let* email = field fields "email" string in

     

       25
       25
       -
           let* full_name = field fields "full_name" string in

     

       26
       26
       -
           let* short_name = field_opt fields "short_name" string in

     

       27
       27
       -
           Ok { user_id; email; full_name; short_name }) json

     

       87
       87
       +
           match Zulip.Encode.from_json jsont json with

     

       88
       88
       +
           | Ok v -> Ok v

     

       89
       89
       +
           | Error msg -> Error (Zulip.create_error ~code:(Other "json_parse_error") ~msg ())

     

       28
       90
        
       end

     

       29
       91
        
       

     

       30
       92
        
       (** Reaction representation *)

     
···

       34
       96
        
           emoji_code: string;

     

       35
       97
        
           reaction_type: string;

     

       36
       98
        
           user_id: int;

     

       99
       99
       +
           unknown: Jsont.json;  (** Unknown/extra JSON fields preserved during parsing *)

     

       37
       100
        
         }

     

       38
       101
        
       

     

       39
       102
        
         let emoji_name t = t.emoji_name

     
···

       41
       104
        
         let reaction_type t = t.reaction_type

     

       42
       105
        
         let user_id t = t.user_id

     

       43
       106
        
       

     

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

     

       108
       108
       +
         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"

     

       155
       155
       +
           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)

     

       171
       171
       +
           in

     

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

     

       173
       173
       +
       

     

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

     

       45
       45
       -
           let open Zulip.Jsonu_syntax in

     

       46
       46
       -
           (Zulip.Jsonu.with_object "reaction" @@ fun fields ->

     

       47
       47
       -
           let* emoji_name = field fields "emoji_name" string in

     

       48
       48
       -
           let* emoji_code = field fields "emoji_code" string in

     

       49
       49
       -
           let* reaction_type = field fields "reaction_type" string in

     

       50
       50
       -
           let* user_id =

     

       51
       51
       -
             (field fields "user_id" int) <|>

     

       52
       52
       -
             (match field fields "user" object_ with

     

       53
       53
       -
              | Ok user_obj -> field user_obj "user_id" int

     

       54
       54
       -
              | Error _ -> fail "user_id not found") in

     

       55
       55
       -
           Ok { emoji_name; emoji_code; reaction_type; user_id }) json

     

       175
       175
       +
           match Zulip.Encode.from_json jsont json with

     

       176
       176
       +
           | Ok v -> Ok v

     

       177
       177
       +
           | Error msg -> Error (Zulip.create_error ~code:(Other "json_parse_error") ~msg ())

     

       56
       178
        
       end

     

       57
       179
        
       

     

       58
       180
        
       let parse_reaction_json json = Reaction.of_json json

     
···

       96
       218
        
       

     

       97
       219
        
       (** Helper function to parse common fields *)

     

       98
       220
        
       let parse_common json =

     

       99
       99
       -
         Zulip.Jsonu.parse_with_error "common fields" @@ fun () ->

     

       100
       100
       -
         (Zulip.Jsonu.with_object "message" @@ fun fields ->

     

       101
       101
       -
         let open Zulip.Jsonu_syntax in

     

       102
       102
       -
         let* id = field fields "id" int in

     

       103
       103
       -
         let* sender_id = field fields "sender_id" int in

     

       104
       104
       -
         let* sender_email = field fields "sender_email" string in

     

       105
       105
       -
         let* sender_full_name = field fields "sender_full_name" string in

     

       106
       106
       -
         let sender_short_name = field_opt fields "sender_short_name" string |? None in

     

       107
       107
       -
         let timestamp = field_or fields "timestamp" float 0.0 |? 0.0 in

     

       108
       108
       -
         let content = field_or fields "content" string "" |? "" in

     

       109
       109
       -
         let content_type = field_or fields "content_type" string "text/html" |? "text/html" in

     

       221
       221
       +
         match json with

     

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

     

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

     

       224
       224
       +
             let get_int key =

     

       225
       225
       +
               match List.assoc_opt key assoc with

     

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

     

       227
       227
       +
               | _ -> None

     

       228
       228
       +
             in

     

       229
       229
       +
             let get_string key =

     

       230
       230
       +
               match List.assoc_opt key assoc with

     

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

     

       232
       232
       +
               | _ -> None

     

       233
       233
       +
             in

     

       234
       234
       +
             let get_float key default =

     

       235
       235
       +
               match List.assoc_opt key assoc with

     

       236
       236
       +
               | Some (Jsont.Number (f, _)) -> f

     

       237
       237
       +
               | _ -> default

     

       238
       238
       +
             in

     

       239
       239
       +
             let get_bool key default =

     

       240
       240
       +
               match List.assoc_opt key assoc with

     

       241
       241
       +
               | Some (Jsont.Bool (b, _)) -> b

     

       242
       242
       +
               | _ -> default

     

       243
       243
       +
             in

     

       244
       244
       +
             let get_array key =

     

       245
       245
       +
               match List.assoc_opt key assoc with

     

       246
       246
       +
               | Some (Jsont.Array (arr, _)) -> Some arr

     

       247
       247
       +
               | _ -> None

     

       248
       248
       +
             in

     

       110
       249
        
       

     

       111
       111
       -
         let reactions =

     

       112
       112
       -
           match Zulip.Jsonu.get_array_opt fields "reactions" with

     

       113
       113
       -
           | Some reactions_json ->

     

       114
       114
       -
               List.filter_map (fun r ->

     

       115
       115
       -
                 match parse_reaction_json r with

     

       116
       116
       -
                 | Ok reaction -> Some reaction

     

       117
       117
       -
                 | Error err ->

     

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

     

       119
       119
       -
                     None

     

       120
       120
       -
               ) reactions_json

     

       121
       121
       -
           | None -> []

     

       122
       122
       -
         in

     

       250
       250
       +
             (match (get_int "id", get_int "sender_id", get_string "sender_email", get_string "sender_full_name") with

     

       251
       251
       +
              | (Some id, Some sender_id, Some sender_email, Some sender_full_name) ->

     

       252
       252
       +
                  let sender_short_name = get_string "sender_short_name" in

     

       253
       253
       +
                  let timestamp = get_float "timestamp" 0.0 in

     

       254
       254
       +
                  let content = get_string "content" |> Option.value ~default:"" in

     

       255
       255
       +
                  let content_type = get_string "content_type" |> Option.value ~default:"text/html" in

     

       123
       256
        
       

     

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

     

       257
       257
       +
                  let reactions =

     

       258
       258
       +
                    match get_array "reactions" with

     

       259
       259
       +
                    | Some reactions_json ->

     

       260
       260
       +
                        List.filter_map (fun r ->

     

       261
       261
       +
                          match parse_reaction_json r with

     

       262
       262
       +
                          | Ok reaction -> Some reaction

     

       263
       263
       +
                          | Error err ->

     

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

     

       265
       265
       +
                              None

     

       266
       266
       +
                        ) reactions_json

     

       267
       267
       +
                    | None -> []

     

       268
       268
       +
                  in

     

       125
       269
        
       

     

       126
       126
       -
         let flags =

     

       127
       127
       -
           match Zulip.Jsonu.get_array_opt fields "flags" with

     

       128
       128
       -
           | Some flags_json -> List.filter_map Zulip.Jsonu.to_string_safe flags_json

     

       129
       129
       -
           | None -> []

     

       130
       130
       -
         in

     

       270
       270
       +
                  let submessages = get_array "submessages" |> Option.value ~default:[] in

     

       131
       271
        
       

     

       132
       132
       -
         let is_me_message = field_or fields "is_me_message" bool false |? false in

     

       133
       133
       -
         let client = field_or fields "client" string "" |? "" in

     

       134
       134
       -
         let gravatar_hash = field_or fields "gravatar_hash" string "" |? "" in

     

       135
       135
       -
         let avatar_url = field_opt fields "avatar_url" string |? None in

     

       272
       272
       +
                  let flags =

     

       273
       273
       +
                    match get_array "flags" with

     

       274
       274
       +
                    | Some flags_json ->

     

       275
       275
       +
                        List.filter_map (fun f ->

     

       276
       276
       +
                          match f with

     

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

     

       278
       278
       +
                          | _ -> None

     

       279
       279
       +
                        ) flags_json

     

       280
       280
       +
                    | None -> []

     

       281
       281
       +
                  in

     

       136
       282
        
       

     

       137
       137
       -
         Ok {

     

       138
       138
       -
           id; sender_id; sender_email; sender_full_name; sender_short_name;

     

       139
       139
       -
           timestamp; content; content_type; reactions; submessages;

     

       140
       140
       -
           flags; is_me_message; client; gravatar_hash; avatar_url

     

       141
       141
       -
         }) json

     

       283
       283
       +
                  let is_me_message = get_bool "is_me_message" false in

     

       284
       284
       +
                  let client = get_string "client" |> Option.value ~default:"" in

     

       285
       285
       +
                  let gravatar_hash = get_string "gravatar_hash" |> Option.value ~default:"" in

     

       286
       286
       +
                  let avatar_url = get_string "avatar_url" in

     

       287
       287
       +
       

     

       288
       288
       +
                  Ok {

     

       289
       289
       +
                    id; sender_id; sender_email; sender_full_name; sender_short_name;

     

       290
       290
       +
                    timestamp; content; content_type; reactions; submessages;

     

       291
       291
       +
                    flags; is_me_message; client; gravatar_hash; avatar_url

     

       292
       292
       +
                  }

     

       293
       293
       +
              | _ -> Error (Zulip.create_error ~code:(Other "json_parse_error") ~msg:"Missing required message fields" ()))

     

       294
       294
       +
         | _ -> Error (Zulip.create_error ~code:(Other "json_parse_error") ~msg:"Expected JSON object for message" ())

     

       142
       295
        
       

     

       143
       296
        
       (** JSON parsing *)

     

       144
       297
        
       let of_json json =

     

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

     

       298
       298
       +
         (* Helper to pretty print JSON without using jsonu *)

     

       299
       299
       +
         let json_str =

     

       300
       300
       +
           match Jsont_bytesrw.encode_string' Jsont.json json with

     

       301
       301
       +
           | Ok s -> s

     

       302
       302
       +
           | Error _ -> "<error encoding json>"

     

       303
       303
       +
         in

     

       304
       304
       +
         Log.debug (fun m -> m "Parsing message JSON: %s" json_str);

     

       146
       305
        
       

     

       147
       147
       -
         let open Zulip.Jsonu_syntax in

     

       148
       306
        
         match parse_common json with

     

       149
       307
        
         | Error err -> Error (Zulip.error_message err)

     

       150
       308
        
         | Ok common ->

     

       151
       151
       -
             (Zulip.Jsonu.parse_with_error "message type" @@ fun () ->

     

       152
       152
       -
             (Zulip.Jsonu.with_object "message" @@ fun fields ->

     

       153
       153
       -
             match Zulip.Jsonu.get_string fields "type" with

     

       154
       154
       -
             | Ok "private" ->

     

       155
       155
       -
                 let* recipient_json = field fields "display_recipient" (array (fun x -> Ok x)) in

     

       156
       156
       -
                 let users = List.filter_map (fun u ->

     

       157
       157
       -
                   match parse_user_json u with

     

       158
       158
       -
                   | Ok user -> Some user

     

       159
       159
       -
                   | Error err ->

     

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

     

       161
       161
       -
                       None

     

       162
       162
       -
                 ) recipient_json in

     

       309
       309
       +
             match json with

     

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

     

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

     

       312
       312
       +
                 let msg_type =

     

       313
       313
       +
                   match List.assoc_opt "type" assoc with

     

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

     

       315
       315
       +
                   | _ -> None

     

       316
       316
       +
                 in

     

       317
       317
       +
                 (match msg_type with

     

       318
       318
       +
                  | Some "private" ->

     

       319
       319
       +
                      (match List.assoc_opt "display_recipient" assoc with

     

       320
       320
       +
                       | Some (Jsont.Array (recipient_json, _)) ->

     

       321
       321
       +
                           let users = List.filter_map (fun u ->

     

       322
       322
       +
                             match parse_user_json u with

     

       323
       323
       +
                             | Ok user -> Some user

     

       324
       324
       +
                             | Error err ->

     

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

     

       326
       326
       +
                                 None

     

       327
       327
       +
                           ) recipient_json in

     

       163
       328
        
       

     

       164
       164
       -
                 if List.length users = 0 && List.length recipient_json > 0 then

     

       165
       165
       -
                   fail "Failed to parse any users in display_recipient"

     

       166
       166
       -
                 else

     

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

     

       329
       329
       +
                           if List.length users = 0 && List.length recipient_json > 0 then

     

       330
       330
       +
                             Error "Failed to parse any users in display_recipient"

     

       331
       331
       +
                           else

     

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

     

       333
       333
       +
                       | _ ->

     

       334
       334
       +
                           Log.warn (fun m -> m "display_recipient is not an array for private message");

     

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

     

       168
       336
        
       

     

       169
       169
       -
             | Ok "stream" ->

     

       170
       170
       -
                 let* display_recipient = field fields "display_recipient" string in

     

       171
       171
       -
                 let* stream_id = field fields "stream_id" int in

     

       172
       172
       -
                 let* subject = field fields "subject" string in

     

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

     

       337
       337
       +
                  | Some "stream" ->

     

       338
       338
       +
                      let display_recipient =

     

       339
       339
       +
                        match List.assoc_opt "display_recipient" assoc with

     

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

     

       341
       341
       +
                        | _ -> None

     

       342
       342
       +
                      in

     

       343
       343
       +
                      let stream_id =

     

       344
       344
       +
                        match List.assoc_opt "stream_id" assoc with

     

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

     

       346
       346
       +
                        | _ -> None

     

       347
       347
       +
                      in

     

       348
       348
       +
                      let subject =

     

       349
       349
       +
                        match List.assoc_opt "subject" assoc with

     

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

     

       351
       351
       +
                        | _ -> None

     

       352
       352
       +
                      in

     

       353
       353
       +
                      (match (display_recipient, stream_id, subject) with

     

       354
       354
       +
                       | (Some display_recipient, Some stream_id, Some subject) ->

     

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

     

       356
       356
       +
                       | _ ->

     

       357
       357
       +
                           Log.warn (fun m -> m "Missing required fields for stream message");

     

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

     

       174
       359
        
       

     

       175
       175
       -
             | Ok unknown_type ->

     

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

     

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

     

       360
       360
       +
                  | Some unknown_type ->

     

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

     

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

     

       178
       363
        
       

     

       179
       179
       -
             | Error _ ->

     

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

     

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

     

       182
       182
       -
             ) json) |> Result.map_error Zulip.error_message

     

       364
       364
       +
                  | None ->

     

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

     

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

     

       367
       367
       +
             | _ -> Error "Expected JSON object for message"

     

       183
       368
        
       

     

       184
       369
        
       (** Accessor functions *)

     

       185
       370
        
       let get_common = function

     
···

       363
       548
        
       (** Pretty print JSON for debugging *)

     

       364
       549
        
       let pp_json_debug ppf json =

     

       365
       550
        
         let open Fmt in

     

       366
       366
       -
         let json_str = Zulip.Jsonu.to_string_pretty json in

     

       551
       551
       +
         let json_str =

     

       552
       552
       +
           match Jsont_bytesrw.encode_string' Jsont.json json with

     

       553
       553
       +
           | Ok s -> s

     

       554
       554
       +
           | Error _ -> "<error encoding json>"

     

       555
       555
       +
         in

     

       367
       556
        
         pf ppf "@[<v>%a@.%a@]"

     

       368
       557
        
           (styled `Bold (styled (`Fg `Blue) string)) "Raw JSON:"

     

       369
       558
        
           (styled (`Fg `Black) string) json_str

+10

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

···

       7
       7
        
           email: string;

     

       8
       8
        
           full_name: string;

     

       9
       9
        
           short_name: string option;

     

       10
       10
       +
           unknown: Jsont.json;  (** Unknown/extra JSON fields preserved during parsing *)

     

       10
       11
        
         }

     

       11
       12
        
       

     

       12
       13
        
         val user_id : t -> int

     

       13
       14
        
         val email : t -> string

     

       14
       15
        
         val full_name : t -> string

     

       15
       16
        
         val short_name : t -> string option

     

       17
       17
       +
       

     

       18
       18
       +
         (** Jsont codec for User *)

     

       19
       19
       +
         val jsont : t Jsont.t

     

       20
       20
       +
       

     

       16
       21
        
         val of_json : Zulip.json -> (t, Zulip.zerror) result

     

       17
       22
        
       end

     

       18
       23
        
       

     
···

       23
       28
        
           emoji_code: string;

     

       24
       29
        
           reaction_type: string;

     

       25
       30
        
           user_id: int;

     

       31
       31
       +
           unknown: Jsont.json;  (** Unknown/extra JSON fields preserved during parsing *)

     

       26
       32
        
         }

     

       27
       33
        
       

     

       28
       34
        
         val emoji_name : t -> string

     

       29
       35
        
         val emoji_code : t -> string

     

       30
       36
        
         val reaction_type : t -> string

     

       31
       37
        
         val user_id : t -> int

     

       38
       38
       +
       

     

       39
       39
       +
         (** Jsont codec for Reaction *)

     

       40
       40
       +
         val jsont : t Jsont.t

     

       41
       41
       +
       

     

       32
       42
        
         val of_json : Zulip.json -> (t, Zulip.zerror) result

     

       33
       43
        
       end

     

       34
       44

+30

stack/zulip/zulip.opam

···

       1
       1
       +
       # This file is generated by dune, edit dune-project instead

     

       2
       2
       +
       opam-version: "2.0"

     

       3
       3
       +
       synopsis: "OCaml bindings for the Zulip REST API"

     

       4
       4
       +
       description:

     

       5
       5
       +
         "High-quality OCaml bindings to the Zulip REST API using EIO for async operations"

     

       6
       6
       +
       depends: [

     

       7
       7
       +
         "ocaml"

     

       8
       8
       +
         "dune" {>= "3.0"}

     

       9
       9
       +
         "eio"

     

       10
       10
       +
         "requests"

     

       11
       11
       +
         "uri"

     

       12
       12
       +
         "base64"

     

       13
       13
       +
         "alcotest" {with-test}

     

       14
       14
       +
         "eio_main" {with-test}

     

       15
       15
       +
         "odoc" {with-doc}

     

       16
       16
       +
       ]

     

       17
       17
       +
       build: [

     

       18
       18
       +
         ["dune" "subst"] {dev}

     

       19
       19
       +
         [

     

       20
       20
       +
           "dune"

     

       21
       21
       +
           "build"

     

       22
       22
       +
           "-p"

     

       23
       23
       +
           name

     

       24
       24
       +
           "-j"

     

       25
       25
       +
           jobs

     

       26
       26
       +
           "@install"

     

       27
       27
       +
           "@runtest" {with-test}

     

       28
       28
       +
           "@doc" {with-doc}

     

       29
       29
       +
         ]

     

       30
       30
       +
       ]

+26

stack/zulip/zulip_bot.opam

···

       1
       1
       +
       # This file is generated by dune, edit dune-project instead

     

       2
       2
       +
       opam-version: "2.0"

     

       3
       3
       +
       synopsis: "OCaml bot framework for Zulip"

     

       4
       4
       +
       description: "Interactive bot framework built on the OCaml Zulip library"

     

       5
       5
       +
       depends: [

     

       6
       6
       +
         "ocaml"

     

       7
       7
       +
         "dune" {>= "3.0"}

     

       8
       8
       +
         "zulip"

     

       9
       9
       +
         "eio"

     

       10
       10
       +
         "alcotest" {with-test}

     

       11
       11
       +
         "odoc" {with-doc}

     

       12
       12
       +
       ]

     

       13
       13
       +
       build: [

     

       14
       14
       +
         ["dune" "subst"] {dev}

     

       15
       15
       +
         [

     

       16
       16
       +
           "dune"

     

       17
       17
       +
           "build"

     

       18
       18
       +
           "-p"

     

       19
       19
       +
           name

     

       20
       20
       +
           "-j"

     

       21
       21
       +
           jobs

     

       22
       22
       +
           "@install"

     

       23
       23
       +
           "@runtest" {with-test}

     

       24
       24
       +
           "@doc" {with-doc}

     

       25
       25
       +
         ]

     

       26
       26
       +
       ]

+29

stack/zulip/zulip_botserver.opam

···

       1
       1
       +
       # This file is generated by dune, edit dune-project instead

     

       2
       2
       +
       opam-version: "2.0"

     

       3
       3
       +
       synopsis: "OCaml bot server for running multiple Zulip bots"

     

       4
       4
       +
       description:

     

       5
       5
       +
         "HTTP server for running multiple Zulip bots with webhook support"

     

       6
       6
       +
       depends: [

     

       7
       7
       +
         "ocaml"

     

       8
       8
       +
         "dune" {>= "3.0"}

     

       9
       9
       +
         "zulip"

     

       10
       10
       +
         "zulip_bot"

     

       11
       11
       +
         "eio"

     

       12
       12
       +
         "requests"

     

       13
       13
       +
         "alcotest" {with-test}

     

       14
       14
       +
         "odoc" {with-doc}

     

       15
       15
       +
       ]

     

       16
       16
       +
       build: [

     

       17
       17
       +
         ["dune" "subst"] {dev}

     

       18
       18
       +
         [

     

       19
       19
       +
           "dune"

     

       20
       20
       +
           "build"

     

       21
       21
       +
           "-p"

     

       22
       22
       +
           name

     

       23
       23
       +
           "-j"

     

       24
       24
       +
           jobs

     

       25
       25
       +
           "@install"

     

       26
       26
       +
           "@runtest" {with-test}

     

       27
       27
       +
           "@doc" {with-doc}

     

       28
       28
       +
         ]

     

       29
       29
       +
       ]