commit 54d682d98c765a36d1c22eec927e81a7b6a2ca33 · anil.recoil.org/slop

-2

CLAUDE.md

···

       1
       1
       -
       This is a monorepo of a collection of OCaml libraries that should all work together, but they are in different stages of porting. Ultimately, the goal is to use Eio for everything and move away from Lwt entirely. For HTTP(S) requests the idea is to use River as the main high evel 'http requests' API, so anything using Cohttp or other HTTP fetchers will need to be ported.

     

       2
       2
       -

+232

stack/TODO.md

···

       1
       1
       +
       # Production Quality TODO

     

       2
       2
       +
       

     

       3
       3
       +
       This document tracks remaining tasks to make the immutable Requests.t and refactored library patterns production-ready.

     

       4
       4
       +
       

     

       5
       5
       +
       ## High Priority

     

       6
       6
       +
       

     

       7
       7
       +
       ### 1. Update Immiche README.md ⚠️

     

       8
       8
       +
       **Status:** Outdated

     

       9
       9
       +
       **Location:** `immiche/README.md`

     

       10
       10
       +
       

     

       11
       11
       +
       The README still documents the old API (passing `~sw ~clock ~net ~base_url ~api_key` on every call) instead of the new session-based pattern.

     

       12
       12
       +
       

     

       13
       13
       +
       **Tasks:**

     

       14
       14
       +
       - [ ] Update API signatures to show `create` function

     

       15
       15
       +
       - [ ] Update example code to show session creation

     

       16
       16
       +
       - [ ] Document connection pooling benefits

     

       17
       17
       +
       - [ ] Update "Implementation Notes" to mention `Requests.t` instead of `Requests.One`

     

       18
       18
       +
       - [ ] Add example of sharing sessions across multiple libraries

     

       19
       19
       +
       

     

       20
       20
       +
       **Example of needed change:**

     

       21
       21
       +
       ```ocaml

     

       22
       22
       +
       (* OLD - documented in README *)

     

       23
       23
       +
       let people = Immiche.fetch_people ~sw ~clock ~net ~base_url ~api_key

     

       24
       24
       +
       

     

       25
       25
       +
       (* NEW - what actually works now *)

     

       26
       26
       +
       let client = Immiche.create ~sw ~env ~base_url ~api_key () in

     

       27
       27
       +
       let people = Immiche.fetch_people client

     

       28
       28
       +
       ```

     

       29
       29
       +
       

     

       30
       30
       +
       ### 2. Improve Error Handling in Immiche

     

       31
       31
       +
       **Status:** Inconsistent

     

       32
       32
       +
       **Location:** `immiche/immiche.ml:79,92,133`

     

       33
       33
       +
       

     

       34
       34
       +
       Currently uses `failwith` for HTTP errors instead of returning Result types consistently.

     

       35
       35
       +
       

     

       36
       36
       +
       **Issues:**

     

       37
       37
       +
       - `fetch_people`, `fetch_person`, `search_person` use `failwith` for HTTP errors

     

       38
       38
       +
       - `download_thumbnail` correctly returns `Result`

     

       39
       39
       +
       - Inconsistent error handling makes it hard to gracefully handle failures

     

       40
       40
       +
       

     

       41
       41
       +
       **Tasks:**

     

       42
       42
       +
       - [ ] Change `fetch_people` to return `(people_response, [> `Msg of string]) result`

     

       43
       43
       +
       - [ ] Change `fetch_person` to return `(person, [> `Msg of string]) result`

     

       44
       44
       +
       - [ ] Change `search_person` to return `(person list, [> `Msg of string]) result`

     

       45
       45
       +
       - [ ] Update `immiche/immiche.mli` with new signatures

     

       46
       46
       +
       - [ ] Update `bushel/bin/bushel_faces.ml` to handle Result types

     

       47
       47
       +
       - [ ] Document error cases in docstrings

     

       48
       48
       +
       

     

       49
       49
       +
       ### 3. Add Type Aliases for Verbose Signatures

     

       50
       50
       +
       **Status:** Verbose

     

       51
       51
       +
       **Location:** `immiche/immiche.mli`, `zotero-translation/zotero_translation.mli`

     

       52
       52
       +
       

     

       53
       53
       +
       Type signatures like `([> float Eio.Time.clock_ty ] Eio.Resource.t, [> [> `Generic ] Eio.Net.ty ] Eio.Resource.t) t` are extremely verbose.

     

       54
       54
       +
       

     

       55
       55
       +
       **Tasks:**

     

       56
       56
       +
       - [ ] Consider adding type aliases:

     

       57
       57
       +
         ```ocaml

     

       58
       58
       +
         type client =

     

       59
       59
       +
           ([> float Eio.Time.clock_ty ] Eio.Resource.t,

     

       60
       60
       +
            [> [> `Generic ] Eio.Net.ty ] Eio.Resource.t) t

     

       61
       61
       +
       

     

       62
       62
       +
         val fetch_people : client -> people_response

     

       63
       63
       +
         ```

     

       64
       64
       +
       - [ ] Evaluate if this improves or harms the API (might hide important type info)

     

       65
       65
       +
       - [ ] If beneficial, apply to both Immiche and zotero-translation

     

       66
       66
       +
       

     

       67
       67
       +
       ## Medium Priority

     

       68
       68
       +
       

     

       69
       69
       +
       ### 4. Add Tests for New Immiche Pattern

     

       70
       70
       +
       **Status:** No tests

     

       71
       71
       +
       **Location:** None - needs creation

     

       72
       72
       +
       

     

       73
       73
       +
       The Immiche library was refactored but has no tests.

     

       74
       74
       +
       

     

       75
       75
       +
       **Tasks:**

     

       76
       76
       +
       - [ ] Create `immiche/test/test_immiche.ml`

     

       77
       77
       +
       - [ ] Add test for `create` function

     

       78
       78
       +
       - [ ] Add tests for all API functions with mocked responses

     

       79
       79
       +
       - [ ] Test connection pooling behavior (multiple requests reuse connections)

     

       80
       80
       +
       - [ ] Test session sharing (derived sessions share pools)

     

       81
       81
       +
       - [ ] Add to dune test suite

     

       82
       82
       +
       

     

       83
       83
       +
       ### 5. Verify Zotero-translation with Immutable Requests.t

     

       84
       84
       +
       **Status:** Unknown compatibility

     

       85
       85
       +
       **Location:** `zotero-translation/`

     

       86
       86
       +
       

     

       87
       87
       +
       Zotero-translation was already using session pattern before we made Requests.t immutable. Need to verify it still works correctly.

     

       88
       88
       +
       

     

       89
       89
       +
       **Tasks:**

     

       90
       90
       +
       - [ ] Review if zotero-translation needs updates for immutable Requests.t

     

       91
       91
       +
       - [ ] Check if any derived sessions are created (and if pools are shared correctly)

     

       92
       92
       +
       - [ ] Add tests if missing

     

       93
       93
       +
       - [ ] Document session sharing pattern if used

     

       94
       94
       +
       

     

       95
       95
       +
       ### 6. Document Thread Safety / Concurrency Model

     

       96
       96
       +
       **Status:** Unclear

     

       97
       97
       +
       **Location:** Documentation

     

       98
       98
       +
       

     

       99
       99
       +
       With immutable sessions that share mutable cookie_jar and statistics, the concurrency model needs documentation.

     

       100
       100
       +
       

     

       101
       101
       +
       **Tasks:**

     

       102
       102
       +
       - [ ] Document that derived sessions share:

     

       103
       103
       +
         - Connection pools (intentional - for performance)

     

       104
       104
       +
         - Cookie jar (intentional - session state)

     

       105
       105
       +
         - Statistics (intentional - unified monitoring)

     

       106
       106
       +
       - [ ] Document that cookie_mutex protects concurrent cookie access

     

       107
       107
       +
       - [ ] Clarify if derived sessions can be used safely across Eio fibers

     

       108
       108
       +
       - [ ] Add concurrency examples to documentation

     

       109
       109
       +
       

     

       110
       110
       +
       ### 7. Enhanced API Documentation

     

       111
       111
       +
       **Status:** Basic

     

       112
       112
       +
       **Location:** All `.mli` files

     

       113
       113
       +
       

     

       114
       114
       +
       Current documentation is minimal. Could add more examples and edge case documentation.

     

       115
       115
       +
       

     

       116
       116
       +
       **Tasks:**

     

       117
       117
       +
       - [ ] Add usage examples to `requests/lib/requests.mli` showing:

     

       118
       118
       +
         - Creating base session

     

       119
       119
       +
         - Deriving sessions with different configs

     

       120
       120
       +
         - Sharing pools across derived sessions

     

       121
       121
       +
       - [ ] Document what happens when you derive from derived sessions

     

       122
       122
       +
       - [ ] Add performance notes about connection pooling

     

       123
       123
       +
       - [ ] Document cookie handling behavior

     

       124
       124
       +
       

     

       125
       125
       +
       ## Low Priority

     

       126
       126
       +
       

     

       127
       127
       +
       ### 8. Consider Immutable Statistics

     

       128
       128
       +
       **Status:** Design decision

     

       129
       129
       +
       **Location:** `requests/lib/requests.ml:51-53`

     

       130
       130
       +
       

     

       131
       131
       +
       Statistics (requests_made, total_time, retries_count) are still mutable and shared across derived sessions.

     

       132
       132
       +
       

     

       133
       133
       +
       **Trade-offs:**

     

       134
       134
       +
       - **Current (mutable):** Simple, tracks total usage across all derived sessions

     

       135
       135
       +
       - **Alternative (immutable):** Would require returning `(Response.t * t)` from all request functions

     

       136
       136
       +
       

     

       137
       137
       +
       **Tasks:**

     

       138
       138
       +
       - [ ] Evaluate if immutable statistics would be valuable

     

       139
       139
       +
       - [ ] If yes, design API that returns updated sessions from request functions

     

       140
       140
       +
       - [ ] If no, document the design decision and rationale

     

       141
       141
       +
       

     

       142
       142
       +
       ### 9. Add Examples Directory

     

       143
       143
       +
       **Status:** No standalone examples

     

       144
       144
       +
       **Location:** None

     

       145
       145
       +
       

     

       146
       146
       +
       Would be helpful to have example code showing common patterns.

     

       147
       147
       +
       

     

       148
       148
       +
       **Tasks:**

     

       149
       149
       +
       - [ ] Create `examples/` directory

     

       150
       150
       +
       - [ ] Add `examples/immiche_basic.ml` - basic Immiche usage

     

       151
       151
       +
       - [ ] Add `examples/immiche_advanced.ml` - session sharing across APIs

     

       152
       152
       +
       - [ ] Add `examples/requests_sessions.ml` - derived sessions with shared pools

     

       153
       153
       +
       - [ ] Add `examples/zotero_immiche_shared.ml` - sharing pools between libraries

     

       154
       154
       +
       - [ ] Ensure examples build and run

     

       155
       155
       +
       

     

       156
       156
       +
       ### 10. Performance Benchmarks

     

       157
       157
       +
       **Status:** No benchmarks

     

       158
       158
       +
       **Location:** None

     

       159
       159
       +
       

     

       160
       160
       +
       Would be valuable to have benchmarks showing connection pooling benefits.

     

       161
       161
       +
       

     

       162
       162
       +
       **Tasks:**

     

       163
       163
       +
       - [ ] Create benchmark comparing:

     

       164
       164
       +
         - Requests.One (no pooling) vs Requests.t (with pooling)

     

       165
       165
       +
         - Single session vs derived sessions (verify pool sharing)

     

       166
       166
       +
         - Sequential vs parallel requests

     

       167
       167
       +
       - [ ] Document performance characteristics

     

       168
       168
       +
       - [ ] Add to CI if significant

     

       169
       169
       +
       

     

       170
       170
       +
       ## Breaking Changes Documented

     

       171
       171
       +
       

     

       172
       172
       +
       ### Immiche API (Breaking)

     

       173
       173
       +
       **Old API:**

     

       174
       174
       +
       ```ocaml

     

       175
       175
       +
       val fetch_people :

     

       176
       176
       +
         sw:Eio.Switch.t ->

     

       177
       177
       +
         clock:_ Eio.Time.clock ->

     

       178
       178
       +
         net:_ Eio.Net.t ->

     

       179
       179
       +
         base_url:string ->

     

       180
       180
       +
         api_key:string ->

     

       181
       181
       +
         people_response

     

       182
       182
       +
       ```

     

       183
       183
       +
       

     

       184
       184
       +
       **New API:**

     

       185
       185
       +
       ```ocaml

     

       186
       186
       +
       val create :

     

       187
       187
       +
         sw:Eio.Switch.t ->

     

       188
       188
       +
         env:< clock:_; net:_; fs:_; .. > ->

     

       189
       189
       +
         ?requests_session:_ Requests.t ->

     

       190
       190
       +
         base_url:string ->

     

       191
       191
       +
         api_key:string ->

     

       192
       192
       +
         unit -> t

     

       193
       193
       +
       

     

       194
       194
       +
       val fetch_people : t -> people_response

     

       195
       195
       +
       ```

     

       196
       196
       +
       

     

       197
       197
       +
       **Migration Required:**

     

       198
       198
       +
       - All Immiche users must update to create a client first

     

       199
       199
       +
       - Only known usage: `bushel/bin/bushel_faces.ml` (already updated)

     

       200
       200
       +
       

     

       201
       201
       +
       ### Requests Configuration Functions (Breaking)

     

       202
       202
       +
       **Old API:**

     

       203
       203
       +
       ```ocaml

     

       204
       204
       +
       val set_auth : t -> Auth.t -> unit

     

       205
       205
       +
       ```

     

       206
       206
       +
       

     

       207
       207
       +
       **New API:**

     

       208
       208
       +
       ```ocaml

     

       209
       209
       +
       val set_auth : t -> Auth.t -> t

     

       210
       210
       +
       ```

     

       211
       211
       +
       

     

       212
       212
       +
       **Migration Required:**

     

       213
       213
       +
       - Must capture returned session: `let req = Requests.set_auth req auth`

     

       214
       214
       +
       - All usages updated: ocurl.ml, test_requests.ml, jmap_client.ml

     

       215
       215
       +
       

     

       216
       216
       +
       ## Notes

     

       217
       217
       +
       

     

       218
       218
       +
       - **Cookie handling:** Still mutable via shared cookie_jar - this is intentional for session state

     

       219
       219
       +
       - **Statistics:** Still mutable and shared - tracks total usage across derived sessions

     

       220
       220
       +
       - **Connection pools:** Shared across all derived sessions - major performance benefit

     

       221
       221
       +
       - **No backward compatibility:** Breaking changes are acceptable for this monorepo

     

       222
       222
       +
       

     

       223
       223
       +
       ## Completion Checklist

     

       224
       224
       +
       

     

       225
       225
       +
       Before considering this production-ready:

     

       226
       226
       +
       

     

       227
       227
       +
       - [ ] High priority items completed

     

       228
       228
       +
       - [ ] README.md updated for Immiche

     

       229
       229
       +
       - [ ] Error handling consistent across Immiche

     

       230
       230
       +
       - [ ] At least basic tests added for Immiche

     

       231
       231
       +
       - [ ] Documentation covers concurrency model

     

       232
       232
       +
       - [ ] All examples in docs are verified to work

+121 -132

stack/bushel/bin/bushel_doi.ml

···

       1
       1
        
       module ZT = Zotero_translation

     

       2
       2
       -
       open Lwt.Infix

     

       3
       2
        
       module J = Ezjsonm

     

       4
       3
        
       open Cmdliner

     

       5
       4
        
       

     
···

       43
       42
        
       let resolve_doi zt ~verbose doi =

     

       44
       43
        
         Printf.printf "Resolving DOI: %s\n%!" doi;

     

       45
       44
        
         let doi_url = Printf.sprintf "https://doi.org/%s" doi in

     

       46
       46
       -
         Lwt.catch

     

       47
       47
       -
           (fun () ->

     

       48
       48
       -
             ZT.json_of_doi zt ~slug:"temp" doi >>= fun json ->

     

       49
       49
       -
             if verbose then begin

     

       50
       50
       -
               Printf.printf "  Raw Zotero response:\n%s\n%!" (J.value_to_string json)

     

       51
       51
       -
             end;

     

       52
       52
       -
             try

     

       53
       53
       -
               let keys = J.get_dict (json :> J.value) in

     

       54
       54
       -
               let title = J.find json ["title"] |> J.get_string in

     

       55
       55
       -
               let authors = J.find json ["author"] |> J.get_list J.get_string in

     

       56
       56
       -
               let year = J.find json ["year"] |> J.get_string |> int_of_string in

     

       57
       57
       -
               let bibtype = J.find json ["bibtype"] |> J.get_string in

     

       58
       58
       -
               let publisher =

     

       59
       59
       -
                 try

     

       60
       60
       -
                   (* Try journal first, then booktitle, then publisher *)

     

       61
       61
       -
                   match List.assoc_opt "journal" keys with

     

       62
       62
       -
                   | Some j -> J.get_string j

     

       45
       45
       +
         try

     

       46
       46
       +
           let json = ZT.json_of_doi zt ~slug:"temp" doi in

     

       47
       47
       +
           if verbose then begin

     

       48
       48
       +
             Printf.printf "  Raw Zotero response:\n%s\n%!" (J.value_to_string json)

     

       49
       49
       +
           end;

     

       50
       50
       +
           try

     

       51
       51
       +
             let keys = J.get_dict (json :> J.value) in

     

       52
       52
       +
             let title = J.find json ["title"] |> J.get_string in

     

       53
       53
       +
             let authors = J.find json ["author"] |> J.get_list J.get_string in

     

       54
       54
       +
             let year = J.find json ["year"] |> J.get_string |> int_of_string in

     

       55
       55
       +
             let bibtype = J.find json ["bibtype"] |> J.get_string in

     

       56
       56
       +
             let publisher =

     

       57
       57
       +
               try

     

       58
       58
       +
                 (* Try journal first, then booktitle, then publisher *)

     

       59
       59
       +
                 match List.assoc_opt "journal" keys with

     

       60
       60
       +
                 | Some j -> J.get_string j

     

       61
       61
       +
                 | None ->

     

       62
       62
       +
                   match List.assoc_opt "booktitle" keys with

     

       63
       63
       +
                   | Some b -> J.get_string b

     

       63
       64
        
                   | None ->

     

       64
       64
       -
                     match List.assoc_opt "booktitle" keys with

     

       65
       65
       -
                     | Some b -> J.get_string b

     

       66
       66
       -
                     | None ->

     

       67
       67
       -
                       match List.assoc_opt "publisher" keys with

     

       68
       68
       -
                       | Some p -> J.get_string p

     

       69
       69
       -
                       | None -> ""

     

       70
       70
       -
                 with _ -> ""

     

       71
       71
       -
               in

     

       72
       72
       -
               let entry = Bushel.Doi_entry.create_resolved ~doi ~title ~authors ~year ~bibtype ~publisher ~source_urls:[doi_url] () in

     

       73
       73
       -
               Printf.printf "  ✓ Resolved: %s (%d)\n%!" title year;

     

       74
       74
       -
               Lwt.return entry

     

       75
       75
       -
             with e ->

     

       76
       76
       -
               Printf.eprintf "  ✗ Failed to parse response for %s: %s\n%!" doi (Printexc.to_string e);

     

       77
       77
       -
               Lwt.return (Bushel.Doi_entry.create_failed ~doi ~error:(Printexc.to_string e) ~source_urls:[doi_url] ())

     

       78
       78
       -
           )

     

       79
       79
       -
           (fun exn ->

     

       80
       80
       -
             Printf.eprintf "  ✗ Failed to resolve %s: %s\n%!" doi (Printexc.to_string exn);

     

       81
       81
       -
             Lwt.return (Bushel.Doi_entry.create_failed ~doi ~error:(Printexc.to_string exn) ~source_urls:[doi_url] ())

     

       82
       82
       -
           )

     

       65
       65
       +
                     match List.assoc_opt "publisher" keys with

     

       66
       66
       +
                     | Some p -> J.get_string p

     

       67
       67
       +
                     | None -> ""

     

       68
       68
       +
               with _ -> ""

     

       69
       69
       +
             in

     

       70
       70
       +
             let entry = Bushel.Doi_entry.create_resolved ~doi ~title ~authors ~year ~bibtype ~publisher ~source_urls:[doi_url] () in

     

       71
       71
       +
             Printf.printf "  ✓ Resolved: %s (%d)\n%!" title year;

     

       72
       72
       +
             entry

     

       73
       73
       +
           with e ->

     

       74
       74
       +
             Printf.eprintf "  ✗ Failed to parse response for %s: %s\n%!" doi (Printexc.to_string e);

     

       75
       75
       +
             Bushel.Doi_entry.create_failed ~doi ~error:(Printexc.to_string e) ~source_urls:[doi_url] ()

     

       76
       76
       +
         with exn ->

     

       77
       77
       +
           Printf.eprintf "  ✗ Failed to resolve %s: %s\n%!" doi (Printexc.to_string exn);

     

       78
       78
       +
           Bushel.Doi_entry.create_failed ~doi ~error:(Printexc.to_string exn) ~source_urls:[doi_url] ()

     

       83
       79
        
       

     

       84
       80
        
       (* Resolve a publisher URL via Zotero /web endpoint *)

     

       85
       81
        
       let resolve_url zt ~verbose url =

     

       86
       82
        
         Printf.printf "Resolving URL: %s\n%!" url;

     

       87
       87
       -
         Lwt.catch

     

       88
       88
       -
           (fun () ->

     

       89
       89
       -
             (* Use Zotero's resolve_url which calls /web endpoint with the URL directly *)

     

       90
       90
       -
             ZT.resolve_url zt url >>= function

     

       91
       91
       -
             | Error (`Msg err) ->

     

       92
       92
       -
               Printf.eprintf "  ✗ Failed to resolve URL: %s\n%!" err;

     

       93
       93
       -
               Lwt.return (Bushel.Doi_entry.create_failed ~doi:url ~error:err ~source_urls:[url] ())

     

       94
       94
       -
             | Ok json ->

     

       95
       95
       -
               if verbose then begin

     

       96
       96
       -
                 Printf.printf "  Raw Zotero response:\n%s\n%!" (J.value_to_string json)

     

       97
       97
       -
               end;

     

       98
       98
       -
               try

     

       99
       99
       -
                 (* Extract metadata from the JSON response *)

     

       100
       100
       -
                 let json_list = match json with

     

       101
       101
       -
                   | `A lst -> lst

     

       102
       102
       -
                   | single -> [single]

     

       83
       83
       +
         try

     

       84
       84
       +
           (* Use Zotero's resolve_url which calls /web endpoint with the URL directly *)

     

       85
       85
       +
           match ZT.resolve_url zt url with

     

       86
       86
       +
           | Error (`Msg err) ->

     

       87
       87
       +
             Printf.eprintf "  ✗ Failed to resolve URL: %s\n%!" err;

     

       88
       88
       +
             Bushel.Doi_entry.create_failed ~doi:url ~error:err ~source_urls:[url] ()

     

       89
       89
       +
           | Ok json ->

     

       90
       90
       +
             if verbose then begin

     

       91
       91
       +
               Printf.printf "  Raw Zotero response:\n%s\n%!" (J.value_to_string (json :> J.value))

     

       92
       92
       +
             end;

     

       93
       93
       +
             try

     

       94
       94
       +
               (* Extract metadata from the JSON response *)

     

       95
       95
       +
               let json_list = match json with

     

       96
       96
       +
                 | `A lst -> lst

     

       97
       97
       +
                 | single -> [(single :> J.value)]

     

       98
       98
       +
               in

     

       99
       99
       +
               match json_list with

     

       100
       100
       +
               | [] ->

     

       101
       101
       +
                 Printf.eprintf "  ✗ Empty response\n%!";

     

       102
       102
       +
                 Bushel.Doi_entry.create_failed ~doi:url ~error:"Empty response" ~source_urls:[url] ()

     

       103
       103
       +
               | item :: _ ->

     

       104
       104
       +
                 (* Extract DOI if present, otherwise use URL *)

     

       105
       105
       +
                 let doi = try J.find item ["DOI"] |> J.get_string with _ ->

     

       106
       106
       +
                   try J.find item ["doi"] |> J.get_string with _ -> url

     

       107
       107
       +
                 in

     

       108
       108
       +
                 let title = try J.find item ["title"] |> J.get_string with _ ->

     

       109
       109
       +
                   "Unknown Title"

     

       110
       110
       +
                 in

     

       111
       111
       +
                 (* Extract authors from Zotero's "creators" field *)

     

       112
       112
       +
                 let authors = try

     

       113
       113
       +
                   J.find item ["creators"] |> J.get_list (fun creator_obj ->

     

       114
       114
       +
                     try

     

       115
       115
       +
                       let last_name = J.find creator_obj ["lastName"] |> J.get_string in

     

       116
       116
       +
                       let first_name = try J.find creator_obj ["firstName"] |> J.get_string with _ -> "" in

     

       117
       117
       +
                       if first_name = "" then last_name else first_name ^ " " ^ last_name

     

       118
       118
       +
                     with _ -> "Unknown Author"

     

       119
       119
       +
                   )

     

       120
       120
       +
                 with _ -> []

     

       121
       121
       +
                 in

     

       122
       122
       +
                 (* Extract year from Zotero's "date" field *)

     

       123
       123
       +
                 (* Handles both ISO format "2025-07" and text format "November 28, 2023" *)

     

       124
       124
       +
                 let year = try

     

       125
       125
       +
                   let date_str = J.find item ["date"] |> J.get_string in

     

       126
       126
       +
                   (* First try splitting on '-' for ISO dates like "2025-07" or "2024-11-04" *)

     

       127
       127
       +
                   let parts = String.split_on_char '-' date_str in

     

       128
       128
       +
                   match parts with

     

       129
       129
       +
                   | year_str :: _ when String.length year_str = 4 ->

     

       130
       130
       +
                     (try int_of_string year_str with _ -> 0)

     

       131
       131
       +
                   | _ ->

     

       132
       132
       +
                     (* Try splitting on space and comma for dates like "November 28, 2023" *)

     

       133
       133
       +
                     let space_parts = String.split_on_char ' ' date_str in

     

       134
       134
       +
                     let year_candidate = List.find_opt (fun s ->

     

       135
       135
       +
                       let s = String.trim (String.map (fun c -> if c = ',' then ' ' else c) s) in

     

       136
       136
       +
                       String.length s = 4 && String.for_all (function '0'..'9' -> true | _ -> false) s

     

       137
       137
       +
                     ) space_parts in

     

       138
       138
       +
                     (match year_candidate with

     

       139
       139
       +
                      | Some year_str -> int_of_string (String.trim year_str)

     

       140
       140
       +
                      | None -> 0)

     

       141
       141
       +
                 with _ -> 0

     

       103
       142
        
                 in

     

       104
       104
       -
                 match json_list with

     

       105
       105
       -
                 | [] ->

     

       106
       106
       -
                   Printf.eprintf "  ✗ Empty response\n%!";

     

       107
       107
       -
                   Lwt.return (Bushel.Doi_entry.create_failed ~doi:url ~error:"Empty response" ~source_urls:[url] ())

     

       108
       108
       -
                 | item :: _ ->

     

       109
       109
       -
                   (* Extract DOI if present, otherwise use URL *)

     

       110
       110
       -
                   let doi = try J.find item ["DOI"] |> J.get_string with _ ->

     

       111
       111
       -
                     try J.find item ["doi"] |> J.get_string with _ -> url

     

       112
       112
       -
                   in

     

       113
       113
       -
                   let title = try J.find item ["title"] |> J.get_string with _ ->

     

       114
       114
       -
                     "Unknown Title"

     

       115
       115
       -
                   in

     

       116
       116
       -
                   (* Extract authors from Zotero's "creators" field *)

     

       117
       117
       -
                   let authors = try

     

       118
       118
       -
                     J.find item ["creators"] |> J.get_list (fun creator_obj ->

     

       119
       119
       -
                       try

     

       120
       120
       -
                         let last_name = J.find creator_obj ["lastName"] |> J.get_string in

     

       121
       121
       -
                         let first_name = try J.find creator_obj ["firstName"] |> J.get_string with _ -> "" in

     

       122
       122
       -
                         if first_name = "" then last_name else first_name ^ " " ^ last_name

     

       123
       123
       -
                       with _ -> "Unknown Author"

     

       124
       124
       -
                     )

     

       125
       125
       -
                   with _ -> []

     

       126
       126
       -
                   in

     

       127
       127
       -
                   (* Extract year from Zotero's "date" field *)

     

       128
       128
       -
                   (* Handles both ISO format "2025-07" and text format "November 28, 2023" *)

     

       129
       129
       -
                   let year = try

     

       130
       130
       -
                     let date_str = J.find item ["date"] |> J.get_string in

     

       131
       131
       -
                     (* First try splitting on '-' for ISO dates like "2025-07" or "2024-11-04" *)

     

       132
       132
       -
                     let parts = String.split_on_char '-' date_str in

     

       133
       133
       -
                     match parts with

     

       134
       134
       -
                     | year_str :: _ when String.length year_str = 4 ->

     

       135
       135
       -
                       (try int_of_string year_str with _ -> 0)

     

       136
       136
       -
                     | _ ->

     

       137
       137
       -
                       (* Try splitting on space and comma for dates like "November 28, 2023" *)

     

       138
       138
       -
                       let space_parts = String.split_on_char ' ' date_str in

     

       139
       139
       -
                       let year_candidate = List.find_opt (fun s ->

     

       140
       140
       -
                         let s = String.trim (String.map (fun c -> if c = ',' then ' ' else c) s) in

     

       141
       141
       -
                         String.length s = 4 && String.for_all (function '0'..'9' -> true | _ -> false) s

     

       142
       142
       -
                       ) space_parts in

     

       143
       143
       -
                       (match year_candidate with

     

       144
       144
       -
                        | Some year_str -> int_of_string (String.trim year_str)

     

       145
       145
       -
                        | None -> 0)

     

       146
       146
       -
                   with _ -> 0

     

       147
       147
       -
                   in

     

       148
       148
       -
                   (* Extract type/bibtype from Zotero's "itemType" field *)

     

       149
       149
       -
                   let bibtype = try J.find item ["itemType"] |> J.get_string with _ -> "article" in

     

       150
       150
       -
                   (* Extract publisher/journal from Zotero's "publicationTitle" field *)

     

       151
       151
       -
                   let publisher = try

     

       152
       152
       -
                     J.find item ["publicationTitle"] |> J.get_string

     

       153
       153
       -
                   with _ -> ""

     

       154
       154
       -
                   in

     

       155
       155
       -
                   (* Include both the original URL and the DOI URL in source_urls *)

     

       156
       156
       -
                   let doi_url = if doi = url then [] else [Printf.sprintf "https://doi.org/%s" doi] in

     

       157
       157
       -
                   let source_urls = url :: doi_url in

     

       158
       158
       -
                   let entry = Bushel.Doi_entry.create_resolved ~doi ~title ~authors ~year ~bibtype ~publisher ~source_urls () in

     

       159
       159
       -
                   Printf.printf "  ✓ Resolved: %s (%d) [DOI: %s]\n%!" title year doi;

     

       160
       160
       -
                   Lwt.return entry

     

       161
       161
       -
               with e ->

     

       162
       162
       -
                 Printf.eprintf "  ✗ Failed to parse response: %s\n%!" (Printexc.to_string e);

     

       163
       163
       -
                 Lwt.return (Bushel.Doi_entry.create_failed ~doi:url ~error:(Printexc.to_string e) ~source_urls:[url] ())

     

       164
       164
       -
           )

     

       165
       165
       -
           (fun exn ->

     

       166
       166
       -
             Printf.eprintf "  ✗ Failed to resolve %s: %s\n%!" url (Printexc.to_string exn);

     

       167
       167
       -
             Lwt.return (Bushel.Doi_entry.create_failed ~doi:url ~error:(Printexc.to_string exn) ~source_urls:[url] ())

     

       168
       168
       -
           )

     

       143
       143
       +
                 (* Extract type/bibtype from Zotero's "itemType" field *)

     

       144
       144
       +
                 let bibtype = try J.find item ["itemType"] |> J.get_string with _ -> "article" in

     

       145
       145
       +
                 (* Extract publisher/journal from Zotero's "publicationTitle" field *)

     

       146
       146
       +
                 let publisher = try

     

       147
       147
       +
                   J.find item ["publicationTitle"] |> J.get_string

     

       148
       148
       +
                 with _ -> ""

     

       149
       149
       +
                 in

     

       150
       150
       +
                 (* Include both the original URL and the DOI URL in source_urls *)

     

       151
       151
       +
                 let doi_url = if doi = url then [] else [Printf.sprintf "https://doi.org/%s" doi] in

     

       152
       152
       +
                 let source_urls = url :: doi_url in

     

       153
       153
       +
                 let entry = Bushel.Doi_entry.create_resolved ~doi ~title ~authors ~year ~bibtype ~publisher ~source_urls () in

     

       154
       154
       +
                 Printf.printf "  ✓ Resolved: %s (%d) [DOI: %s]\n%!" title year doi;

     

       155
       155
       +
                 entry

     

       156
       156
       +
             with e ->

     

       157
       157
       +
               Printf.eprintf "  ✗ Failed to parse response: %s\n%!" (Printexc.to_string e);

     

       158
       158
       +
               Bushel.Doi_entry.create_failed ~doi:url ~error:(Printexc.to_string e) ~source_urls:[url] ()

     

       159
       159
       +
         with exn ->

     

       160
       160
       +
           Printf.eprintf "  ✗ Failed to resolve %s: %s\n%!" url (Printexc.to_string exn);

     

       161
       161
       +
           Bushel.Doi_entry.create_failed ~doi:url ~error:(Printexc.to_string exn) ~source_urls:[url] ()

     

       169
       162
        
       

     

       170
       163
        
       let run base_dir force verbose =

     

       171
       164
        
         Printf.printf "Loading bushel database...\n%!";

     
···

       222
       215
        
         end else begin

     

       223
       216
        
           Printf.printf "Resolving %d DOI(s) and %d URL(s)...\n%!" (List.length dois_to_resolve) (List.length urls_to_resolve);

     

       224
       217
        
       

     

       225
       225
       -
           let zt = ZT.v "http://svr-avsm2-eeg-ce:1969" in

     

       226
       226
       -
       

     

       227
       227
       -
           (* Resolve all DOIs *)

     

       228
       228
       -
           let resolved_doi_entries_lwt =

     

       229
       229
       -
             Lwt_list.map_s (resolve_doi zt ~verbose) dois_to_resolve

     

       230
       230
       -
           in

     

       231
       231
       -
       

     

       232
       232
       -
           (* Resolve all publisher URLs *)

     

       233
       233
       -
           let resolved_url_entries_lwt =

     

       234
       234
       -
             Lwt_list.map_s (resolve_url zt ~verbose) urls_to_resolve

     

       218
       218
       +
           (* Resolve all DOIs and URLs using Eio *)

     

       219
       219
       +
           let new_entries = Eio_main.run @@ fun env ->

     

       220
       220
       +
             Eio.Switch.run @@ fun sw ->

     

       221
       221
       +
               (* Create Zotero Translation client with connection pooling *)

     

       222
       222
       +
               let zt = ZT.create ~sw ~env "http://svr-avsm2-eeg-ce:1969" in

     

       223
       223
       +
               (* Resolve all DOIs *)

     

       224
       224
       +
               let new_doi_entries = List.map (resolve_doi zt ~verbose) dois_to_resolve in

     

       225
       225
       +
               (* Resolve all publisher URLs *)

     

       226
       226
       +
               let new_url_entries = List.map (resolve_url zt ~verbose) urls_to_resolve in

     

       227
       227
       +
               new_doi_entries @ new_url_entries

     

       235
       228
        
           in

     

       236
       236
       -
       

     

       237
       237
       -
           let new_doi_entries = Lwt_main.run resolved_doi_entries_lwt in

     

       238
       238
       -
           let new_url_entries = Lwt_main.run resolved_url_entries_lwt in

     

       239
       239
       -
           let new_entries = new_doi_entries @ new_url_entries in

     

       240
       229
        
       

     

       241
       230
        
           (* Merge with existing entries, combining source_urls for entries with the same DOI *)

     

       242
       231
        
           let all_entries =

+38 -95

stack/bushel/bin/bushel_faces.ml

···

       1
       1
        
       open Cmdliner

     

       2
       2
       -
       open Lwt.Infix

     

       3
       2
        
       open Printf

     

       4
       3
        
       

     

       5
       5
       -
       (* Type for person response *)

     

       6
       6
       -
       type person = {

     

       7
       7
       -
         id: string;

     

       8
       8
       -
         name: string;

     

       9
       9
       -
         thumbnailPath: string option;

     

       10
       10
       -
       }

     

       11
       11
       -
       

     

       12
       12
       -
       (* Parse a person from JSON *)

     

       13
       13
       -
       let parse_person json =

     

       14
       14
       -
         let open Ezjsonm in

     

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

     

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

     

       17
       17
       -
         let thumbnailPath = 

     

       18
       18
       -
           try Some (find json ["thumbnailPath"] |> get_string)

     

       19
       19
       -
           with _ -> None

     

       20
       20
       -
         in

     

       21
       21
       -
         { id; name; thumbnailPath }

     

       22
       22
       -
       

     

       23
       23
       -
       (* Parse a list of people from JSON response *)

     

       24
       24
       -
       let parse_people_response json =

     

       25
       25
       -
         let open Ezjsonm in

     

       26
       26
       -
         get_list parse_person json

     

       27
       27
       -
       

     

       28
       4
        
       (* Read API key from file *)

     

       29
       5
        
       let read_api_key file =

     

       30
       6
        
         let ic = open_in file in

     
···

       32
       8
        
         close_in ic;

     

       33
       9
        
         key

     

       34
       10
        
       

     

       35
       35
       -
       (* Search for a person by name *)

     

       36
       36
       -
       let search_person base_url api_key name =

     

       37
       37
       -
         let open Cohttp_lwt_unix in

     

       38
       38
       -
         let headers = Cohttp.Header.init_with "X-Api-Key" api_key in

     

       39
       39
       -
         let encoded_name = Uri.pct_encode name in

     

       40
       40
       -
         let url = Printf.sprintf "%s/api/search/person?name=%s" base_url encoded_name in

     

       41
       41
       -
         

     

       42
       42
       -
         Client.get ~headers (Uri.of_string url) >>= fun (resp, body) ->

     

       43
       43
       -
         if resp.status = `OK then

     

       44
       44
       -
           Cohttp_lwt.Body.to_string body >>= fun body_str ->

     

       45
       45
       -
           let json = Ezjsonm.from_string body_str in

     

       46
       46
       -
           Lwt.return (parse_people_response json)

     

       47
       47
       -
         else

     

       48
       48
       -
           let status_code = Cohttp.Code.code_of_status resp.status in

     

       49
       49
       -
           Lwt.fail_with (Printf.sprintf "HTTP error: %d" status_code)

     

       50
       50
       -
       

     

       51
       51
       -
       (* Download thumbnail for a person *)

     

       52
       52
       -
       let download_thumbnail base_url api_key person_id output_path =

     

       53
       53
       -
         let open Cohttp_lwt_unix in

     

       54
       54
       -
         let headers = Cohttp.Header.init_with "X-Api-Key" api_key in

     

       55
       55
       -
         let url = Printf.sprintf "%s/api/people/%s/thumbnail" base_url person_id in

     

       56
       56
       -
         

     

       57
       57
       -
         Client.get ~headers (Uri.of_string url) >>= fun (resp, body) ->

     

       58
       58
       -
         match resp.status with

     

       59
       59
       -
         | `OK ->

     

       60
       60
       -
           Cohttp_lwt.Body.to_string body >>= fun img_data ->

     

       61
       61
       -
           (* Ensure output directory exists *)

     

       62
       62
       -
           (try

     

       63
       63
       -
              let dir = Filename.dirname output_path in

     

       64
       64
       -
              if not (Sys.file_exists dir) then Unix.mkdir dir 0o755;

     

       65
       65
       -
              Lwt.return_unit

     

       66
       66
       -
            with _ -> Lwt.return_unit) >>= fun () ->

     

       67
       67
       -
           Lwt_io.with_file ~mode:Lwt_io.output output_path

     

       68
       68
       -
             (fun oc -> Lwt_io.write oc img_data) >>= fun () ->

     

       69
       69
       -
           Lwt.return_ok output_path

     

       70
       70
       -
         | _ ->

     

       71
       71
       -
           let status_code = Cohttp.Code.code_of_status resp.status in

     

       72
       72
       -
           Lwt.return_error (Printf.sprintf "HTTP error: %d" status_code)

     

       73
       73
       -
       

     

       74
       11
        
       (* Get face for a single contact *)

     

       75
       75
       -
       (* TODO:claude *)

     

       76
       76
       -
       let get_face_for_contact base_url api_key output_dir contact =

     

       12
       12
       +
       let get_face_for_contact immiche_client ~fs output_dir contact =

     

       77
       13
        
         let names = Bushel.Contact.names contact in

     

       78
       14
        
         let handle = Bushel.Contact.handle contact in

     

       79
       15
        
         let output_path = Filename.concat output_dir (handle ^ ".jpg") in

     

       80
       16
        
       

     

       81
       17
        
         (* Skip if file already exists *)

     

       82
       18
        
         if Sys.file_exists output_path then

     

       83
       83
       -
           Lwt.return (`Skipped (sprintf "Thumbnail for '%s' already exists at %s" (List.hd names) output_path))

     

       19
       19
       +
           `Skipped (sprintf "Thumbnail for '%s' already exists at %s" (List.hd names) output_path)

     

       84
       20
        
         else begin

     

       85
       21
        
           printf "Processing contact: %s (handle: %s)\n%!" (List.hd names) handle;

     

       86
       22
        
       

     

       87
       23
        
           (* Try each name in the list until we find a match *)

     

       88
       24
        
           let rec try_names = function

     

       89
       25
        
             | [] ->

     

       90
       90
       -
                 Lwt.return (`Error (sprintf "No person found with any name for contact '%s'" handle))

     

       26
       26
       +
                 `Error (sprintf "No person found with any name for contact '%s'" handle)

     

       91
       27
        
             | name :: rest_names ->

     

       92
       28
        
                 printf "  Trying name: %s\n%!" name;

     

       93
       93
       -
                 search_person base_url api_key name >>= function

     

       29
       29
       +
                 let people = Immiche.search_person immiche_client ~name in

     

       30
       30
       +
                 (match people with

     

       94
       31
        
                 | [] ->

     

       95
       32
        
                     printf "  No results for '%s', trying next name...\n%!" name;

     

       96
       33
        
                     try_names rest_names

     

       97
       34
        
                 | person :: _ ->

     

       98
       35
        
                     printf "  Found match for '%s'\n%!" name;

     

       99
       99
       -
                     download_thumbnail base_url api_key person.id output_path >>= function

     

       100
       100
       -
                     | Ok path ->

     

       101
       101
       -
                         Lwt.return (`Ok (sprintf "Saved thumbnail for '%s' to %s" name path))

     

       102
       102
       -
                     | Error err ->

     

       103
       103
       -
                         Lwt.return (`Error (sprintf "Error for '%s': %s" name err))

     

       36
       36
       +
                     let result = Immiche.download_thumbnail immiche_client

     

       37
       37
       +
                       ~fs ~person_id:person.id ~output_path in

     

       38
       38
       +
                     (match result with

     

       39
       39
       +
                     | Ok _ ->

     

       40
       40
       +
                         `Ok (sprintf "Saved thumbnail for '%s' to %s" name output_path)

     

       41
       41
       +
                     | Error (`Msg err) ->

     

       42
       42
       +
                         `Error (sprintf "Error for '%s': %s" name err)))

     

       104
       43
        
           in

     

       105
       44
        
           try_names names

     

       106
       45
        
         end

     

       107
       46
        
       

     

       108
       47
        
       (* Process all contacts or a specific one *)

     

       109
       109
       -
       let process_contacts base_dir output_dir specific_handle api_key base_url =

     

       48
       48
       +
       let process_contacts ~sw ~env base_dir output_dir specific_handle api_key base_url =

     

       110
       49
        
         printf "Loading Bushel database from %s\n%!" base_dir;

     

       111
       50
        
         let db = Bushel.load base_dir in

     

       112
       51
        
         let contacts = Bushel.Entry.contacts db in

     

       113
       52
        
         printf "Found %d contacts\n%!" (List.length contacts);

     

       114
       114
       -
         

     

       53
       53
       +
       

     

       54
       54
       +
         (* Create Immiche client for connection pooling *)

     

       55
       55
       +
         let immiche_client = Immiche.create ~sw ~env ~base_url ~api_key () in

     

       56
       56
       +
       

     

       115
       57
        
         (* Ensure output directory exists *)

     

       116
       58
        
         if not (Sys.file_exists output_dir) then Unix.mkdir output_dir 0o755;

     

       117
       117
       -
         

     

       59
       59
       +
       

     

       118
       60
        
         (* Filter contacts based on specific_handle if provided *)

     

       119
       119
       -
         let contacts_to_process = 

     

       61
       61
       +
         let contacts_to_process =

     

       120
       62
        
           match specific_handle with

     

       121
       121
       -
           | Some handle -> 

     

       63
       63
       +
           | Some handle ->

     

       122
       64
        
               begin match Bushel.Contact.find_by_handle contacts handle with

     

       123
       65
        
               | Some contact -> [contact]

     

       124
       124
       -
               | None -> 

     

       66
       66
       +
               | None ->

     

       125
       67
        
                   eprintf "No contact found with handle '%s'\n%!" handle;

     

       126
       68
        
                   []

     

       127
       69
        
               end

     

       128
       70
        
           | None -> contacts

     

       129
       71
        
         in

     

       130
       130
       -
         

     

       72
       72
       +
       

     

       131
       73
        
         (* Process each contact *)

     

       132
       132
       -
         let results = Lwt_main.run begin

     

       133
       133
       -
           Lwt_list.map_s 

     

       134
       134
       -
             (fun contact -> 

     

       135
       135
       -
                get_face_for_contact base_url api_key output_dir contact >>= fun result ->

     

       136
       136
       -
                Lwt.return (Bushel.Contact.handle contact, result))

     

       137
       137
       -
             contacts_to_process

     

       138
       138
       -
         end in

     

       139
       139
       -
         

     

       74
       74
       +
         let results = List.map

     

       75
       75
       +
           (fun contact ->

     

       76
       76
       +
              let result = get_face_for_contact immiche_client ~fs:env#fs output_dir contact in

     

       77
       77
       +
              (Bushel.Contact.handle contact, result))

     

       78
       78
       +
           contacts_to_process

     

       79
       79
       +
         in

     

       80
       80
       +
       

     

       140
       81
        
         (* Print summary *)

     

       141
       82
        
         let ok_count = List.length (List.filter (fun (_, r) -> match r with `Ok _ -> true | _ -> false) results) in

     

       142
       83
        
         let error_count = List.length (List.filter (fun (_, r) -> match r with `Error _ -> true | _ -> false) results) in

     

       143
       84
        
         let skipped_count = List.length (List.filter (fun (_, r) -> match r with `Skipped _ -> true | _ -> false) results) in

     

       144
       144
       -
         

     

       85
       85
       +
       

     

       145
       86
        
         printf "\nSummary:\n";

     

       146
       87
        
         printf "  Successfully processed: %d\n" ok_count;

     

       147
       88
        
         printf "  Errors: %d\n" error_count;

     

       148
       89
        
         printf "  Skipped (already exist): %d\n" skipped_count;

     

       149
       149
       -
         

     

       90
       90
       +
       

     

       150
       91
        
         (* Print detailed results *)

     

       151
       92
        
         if error_count > 0 then begin

     

       152
       93
        
           printf "\nError details:\n";

     
···

       156
       97
        
             | _ -> ())

     

       157
       98
        
             results;

     

       158
       99
        
         end;

     

       159
       159
       -
         

     

       100
       100
       +
       

     

       160
       101
        
         if ok_count > 0 || skipped_count > 0 then 0 else 1

     

       161
       102
        
       

     

       162
       103
        
       (* Command line interface *)

     
···

       167
       108
        
           const (fun base_dir output_dir handle api_key_file base_url ->

     

       168
       109
        
             try

     

       169
       110
        
               let api_key = read_api_key api_key_file in

     

       170
       170
       -
               process_contacts base_dir output_dir handle api_key base_url

     

       171
       171
       -
             with e -> 

     

       111
       111
       +
               Eio_main.run @@ fun env ->

     

       112
       112
       +
               Eio.Switch.run @@ fun sw ->

     

       113
       113
       +
               process_contacts ~sw ~env base_dir output_dir handle api_key base_url

     

       114
       114
       +
             with e ->

     

       172
       115
        
               eprintf "Error: %s\n%!" (Printexc.to_string e);

     

       173
       116
        
               1

     

       174
       174
       -
           ) $ Bushel_common.base_dir $ Bushel_common.output_dir ~default:"." $ Bushel_common.handle_opt $ 

     

       175
       175
       -
             Bushel_common.api_key_file ~default:".photos-api" $ 

     

       117
       117
       +
           ) $ Bushel_common.base_dir $ Bushel_common.output_dir ~default:"." $ Bushel_common.handle_opt $

     

       118
       118
       +
             Bushel_common.api_key_file ~default:".photos-api" $

     

       176
       119
        
             Bushel_common.url_term ~default:"https://photos.recoil.org" ~doc:"Base URL of the Immich instance")

     

       177
       120
        
       

     

       178
       121
        
       let cmd =

+187 -189

stack/bushel/bin/bushel_links.ml

···

       1
       1
        
       open Cmdliner

     

       2
       2
       -
       open Lwt.Infix

     

       3
       2
        
       

     

       4
       3
        
       (* Helper function for logging with proper flushing *)

     

       5
       4
        
       let log fmt = Fmt.kstr (fun s -> prerr_string s; flush stderr) fmt

     

       6
       6
       -
       let log_verbose verbose fmt = 

     

       7
       7
       -
         if verbose then Fmt.kstr (fun s -> prerr_string s; flush stderr) fmt 

     

       5
       5
       +
       let log_verbose verbose fmt =

     

       6
       6
       +
         if verbose then Fmt.kstr (fun s -> prerr_string s; flush stderr) fmt

     

       8
       7
        
         else Fmt.kstr (fun _ -> ()) fmt

     

       9
       8
        
       

     

       10
       9
        
       (* Initialize a new links.yml file or ensure it exists *)

     
···

       19
       18
        
         0

     

       20
       19
        
       

     

       21
       20
        
       (* Update links.yml from Karakeep *)

     

       22
       22
       -
       let update_from_karakeep base_url api_key_opt tag links_file download_assets =

     

       21
       21
       +
       let update_from_karakeep ~sw ~env base_url api_key_opt tag links_file download_assets =

     

       23
       22
        
         match api_key_opt with

     

       24
       23
        
         | None ->

     

       25
       24
        
             prerr_endline "Error: API key is required.";

     
···

       27
       26
        
             1

     

       28
       27
        
         | Some api_key ->

     

       29
       28
        
             let assets_dir = "data/assets" in

     

       30
       30
       -
             

     

       31
       31
       -
             (* Run the Lwt program *)

     

       32
       32
       -
             Lwt_main.run (

     

       29
       29
       +
       

     

       30
       30
       +
             try

     

       33
       31
        
               print_endline (Fmt.str "Fetching links from %s with tag '%s'..." base_url tag);

     

       34
       34
       -
               

     

       32
       32
       +
       

     

       35
       33
        
               (* Prepare tag filter *)

     

       36
       34
        
               let filter_tags = if tag = "" then [] else [tag] in

     

       37
       37
       -
               

     

       38
       38
       -
               (* Fetch bookmarks from Karakeep with error handling *)

     

       39
       39
       -
               Lwt.catch

     

       40
       40
       -
                 (fun () ->

     

       41
       41
       -
                   Karakeep.fetch_all_bookmarks ~api_key ~filter_tags base_url >>= fun bookmarks ->

     

       42
       42
       -
                   

     

       43
       43
       -
                   print_endline (Fmt.str "Retrieved %d bookmarks from Karakeep" (List.length bookmarks));

     

       44
       44
       -
                   

     

       45
       45
       -
                   (* Read existing links if file exists *)

     

       46
       46
       -
                   let existing_links = Bushel.Link.load_links_file links_file in

     

       47
       47
       -
                   

     

       48
       48
       -
                   (* Convert bookmarks to bushel links *)

     

       49
       49
       -
                   let new_links = List.map (fun bookmark ->

     

       50
       50
       -
                     Karakeep.to_bushel_link ~base_url bookmark

     

       51
       51
       -
                   ) bookmarks in

     

       52
       52
       -
                   

     

       53
       53
       -
                   (* Merge with existing links - keep existing dates (karakeep dates may be unreliable) *)

     

       54
       54
       -
                   let merged_links = Bushel.Link.merge_links existing_links new_links in

     

       55
       55
       -
                   

     

       56
       56
       -
                   (* Save the updated links file *)

     

       57
       57
       -
                   Bushel.Link.save_links_file links_file merged_links;

     

       58
       58
       -
                   

     

       59
       59
       -
                   print_endline (Fmt.str "Updated %s with %d links" links_file (List.length merged_links));

     

       60
       60
       -
                   

     

       61
       61
       -
                   (* Download assets if requested *)

     

       62
       62
       -
                   if download_assets then begin

     

       63
       63
       -
                     print_endline "Downloading assets for bookmarks...";

     

       64
       64
       -
                     

     

       65
       65
       -
                     (* Ensure the assets directory exists *)

     

       66
       66
       -
                     (try Unix.mkdir assets_dir 0o755 with Unix.Unix_error (Unix.EEXIST, _, _) -> ());

     

       67
       67
       -
                     

     

       68
       68
       -
                     (* Process each bookmark with assets *)

     

       69
       69
       -
                     Lwt_list.iter_s (fun bookmark ->

     

       70
       70
       -
                       (* Extract asset IDs from bookmark *)

     

       71
       71
       -
                       let assets = bookmark.Karakeep.assets in

     

       72
       72
       -
                       

     

       73
       73
       -
                       (* Skip if no assets *)

     

       74
       74
       -
                       if assets = [] then

     

       75
       75
       -
                         Lwt.return_unit

     

       76
       76
       -
                       else

     

       77
       77
       -
                         (* Process each asset *)

     

       78
       78
       -
                         Lwt_list.iter_s (fun (asset_id, asset_type) ->

     

       79
       79
       -
                           let asset_dir = Fmt.str "%s/%s" assets_dir asset_id in

     

       80
       80
       -
                           let asset_file = Fmt.str "%s/asset.bin" asset_dir in

     

       81
       81
       -
                           let meta_file = Fmt.str "%s/metadata.json" asset_dir in

     

       82
       82
       -
                           

     

       83
       83
       -
                           (* Skip if the asset already exists *)

     

       84
       84
       -
                           if Sys.file_exists asset_file then

     

       85
       85
       -
                             Lwt.return_unit

     

       86
       86
       -
                           else begin

     

       87
       87
       -
                             (* Create the asset directory *)

     

       88
       88
       -
                             (try Unix.mkdir asset_dir 0o755 with Unix.Unix_error (Unix.EEXIST, _, _) -> ());

     

       89
       89
       -
                             

     

       90
       90
       -
                             (* Download the asset *)

     

       91
       91
       -
                             print_endline (Fmt.str "Downloading %s asset %s..." asset_type asset_id);

     

       92
       92
       -
                             Karakeep.fetch_asset ~api_key base_url asset_id >>= fun data ->

     

       93
       93
       -
                             

     

       94
       94
       -
                             (* Guess content type based on first bytes *)

     

       95
       95
       -
                             let content_type = 

     

       96
       96
       -
                               if String.length data >= 4 && String.sub data 0 4 = "\x89PNG" then

     

       97
       97
       -
                                 "image/png"

     

       98
       98
       -
                               else if String.length data >= 3 && String.sub data 0 3 = "\xFF\xD8\xFF" then

     

       99
       99
       -
                                 "image/jpeg"

     

       100
       100
       -
                               else if String.length data >= 4 && String.sub data 0 4 = "%PDF" then

     

       101
       101
       -
                                 "application/pdf"

     

       102
       102
       -
                               else

     

       103
       103
       -
                                 "application/octet-stream"

     

       104
       104
       -
                             in

     

       105
       105
       -
                             

     

       106
       106
       -
                             (* Write the asset data *)

     

       107
       107
       -
                             Lwt_io.with_file ~mode:Lwt_io.Output asset_file (fun oc ->

     

       108
       108
       -
                               Lwt_io.write oc data

     

       109
       109
       -
                             ) >>= fun () ->

     

       110
       110
       -
                             

     

       111
       111
       -
                             (* Write metadata file *)

     

       112
       112
       -
                             let metadata = Fmt.str "{\n  \"contentType\": \"%s\",\n  \"assetType\": \"%s\"\n}" 

     

       113
       113
       -
                               content_type asset_type in

     

       114
       114
       -
                             Lwt_io.with_file ~mode:Lwt_io.Output meta_file (fun oc ->

     

       115
       115
       -
                               Lwt_io.write oc metadata

     

       116
       116
       -
                             )

     

       117
       117
       -
                           end

     

       118
       118
       -
                         ) assets

     

       119
       119
       -
                     ) bookmarks >>= fun () ->

     

       120
       120
       -
                     

     

       121
       121
       -
                     print_endline "Asset download completed.";

     

       122
       122
       -
                     Lwt.return 0

     

       123
       123
       -
                   end else

     

       124
       124
       -
                     Lwt.return 0

     

       125
       125
       -
                 )

     

       126
       126
       -
                 (fun exn ->

     

       127
       127
       -
                   prerr_endline (Fmt.str "Error fetching bookmarks: %s" (Printexc.to_string exn));

     

       128
       128
       -
                   Lwt.return 1

     

       129
       129
       -
                 )

     

       130
       130
       -
             )

     

       35
       35
       +
       

     

       36
       36
       +
               (* Fetch bookmarks from Karakeep *)

     

       37
       37
       +
               let bookmarks = Karakeepe.fetch_all_bookmarks ~sw ~env ~api_key ~filter_tags base_url in

     

       38
       38
       +
       

     

       39
       39
       +
               print_endline (Fmt.str "Retrieved %d bookmarks from Karakeep" (List.length bookmarks));

     

       40
       40
       +
       

     

       41
       41
       +
               (* Read existing links if file exists *)

     

       42
       42
       +
               let existing_links = Bushel.Link.load_links_file links_file in

     

       43
       43
       +
       

     

       44
       44
       +
               (* Convert bookmarks to bushel links *)

     

       45
       45
       +
               let new_links = List.map (fun bookmark ->

     

       46
       46
       +
                 Karakeepe.to_bushel_link ~base_url bookmark

     

       47
       47
       +
               ) bookmarks in

     

       48
       48
       +
       

     

       49
       49
       +
               (* Merge with existing links - keep existing dates (karakeep dates may be unreliable) *)

     

       50
       50
       +
               let merged_links = Bushel.Link.merge_links existing_links new_links in

     

       51
       51
       +
       

     

       52
       52
       +
               (* Save the updated links file *)

     

       53
       53
       +
               Bushel.Link.save_links_file links_file merged_links;

     

       54
       54
       +
       

     

       55
       55
       +
               print_endline (Fmt.str "Updated %s with %d links" links_file (List.length merged_links));

     

       56
       56
       +
       

     

       57
       57
       +
               (* Download assets if requested *)

     

       58
       58
       +
               if download_assets then begin

     

       59
       59
       +
                 print_endline "Downloading assets for bookmarks...";

     

       60
       60
       +
       

     

       61
       61
       +
                 (* Ensure the assets directory exists *)

     

       62
       62
       +
                 (try Unix.mkdir assets_dir 0o755 with Unix.Unix_error (Unix.EEXIST, _, _) -> ());

     

       63
       63
       +
       

     

       64
       64
       +
                 (* Process each bookmark with assets *)

     

       65
       65
       +
                 List.iter (fun bookmark ->

     

       66
       66
       +
                   (* Extract asset IDs from bookmark *)

     

       67
       67
       +
                   let assets = bookmark.Karakeepe.assets in

     

       68
       68
       +
       

     

       69
       69
       +
                   (* Skip if no assets *)

     

       70
       70
       +
                   if assets <> [] then

     

       71
       71
       +
                     (* Process each asset *)

     

       72
       72
       +
                     List.iter (fun (asset_id, asset_type) ->

     

       73
       73
       +
                       let asset_dir = Fmt.str "%s/%s" assets_dir asset_id in

     

       74
       74
       +
                       let asset_file = Fmt.str "%s/asset.bin" asset_dir in

     

       75
       75
       +
                       let meta_file = Fmt.str "%s/metadata.json" asset_dir in

     

       76
       76
       +
       

     

       77
       77
       +
                       (* Skip if the asset already exists *)

     

       78
       78
       +
                       if not (Sys.file_exists asset_file) then begin

     

       79
       79
       +
                         (* Create the asset directory *)

     

       80
       80
       +
                         (try Unix.mkdir asset_dir 0o755 with Unix.Unix_error (Unix.EEXIST, _, _) -> ());

     

       81
       81
       +
       

     

       82
       82
       +
                         (* Download the asset *)

     

       83
       83
       +
                         print_endline (Fmt.str "Downloading %s asset %s..." asset_type asset_id);

     

       84
       84
       +
                         let data = Karakeepe.fetch_asset ~sw ~env ~api_key base_url asset_id in

     

       85
       85
       +
       

     

       86
       86
       +
                         (* Guess content type based on first bytes *)

     

       87
       87
       +
                         let content_type =

     

       88
       88
       +
                           if String.length data >= 4 && String.sub data 0 4 = "\x89PNG" then

     

       89
       89
       +
                             "image/png"

     

       90
       90
       +
                           else if String.length data >= 3 && String.sub data 0 3 = "\xFF\xD8\xFF" then

     

       91
       91
       +
                             "image/jpeg"

     

       92
       92
       +
                           else if String.length data >= 4 && String.sub data 0 4 = "%PDF" then

     

       93
       93
       +
                             "application/pdf"

     

       94
       94
       +
                           else

     

       95
       95
       +
                             "application/octet-stream"

     

       96
       96
       +
                         in

     

       97
       97
       +
       

     

       98
       98
       +
                         (* Write the asset data *)

     

       99
       99
       +
                         let oc = open_out_bin asset_file in

     

       100
       100
       +
                         output_string oc data;

     

       101
       101
       +
                         close_out oc;

     

       102
       102
       +
       

     

       103
       103
       +
                         (* Write metadata file *)

     

       104
       104
       +
                         let metadata = Fmt.str "{\n  \"contentType\": \"%s\",\n  \"assetType\": \"%s\"\n}"

     

       105
       105
       +
                           content_type asset_type in

     

       106
       106
       +
                         let oc = open_out meta_file in

     

       107
       107
       +
                         output_string oc metadata;

     

       108
       108
       +
                         close_out oc

     

       109
       109
       +
                       end

     

       110
       110
       +
                     ) assets

     

       111
       111
       +
                 ) bookmarks;

     

       112
       112
       +
       

     

       113
       113
       +
                 print_endline "Asset download completed.";

     

       114
       114
       +
                 0

     

       115
       115
       +
               end else

     

       116
       116
       +
                 0

     

       117
       117
       +
             with exn ->

     

       118
       118
       +
               prerr_endline (Fmt.str "Error fetching bookmarks: %s" (Printexc.to_string exn));

     

       119
       119
       +
               1

     

       131
       120
        
       

     

       132
       121
        
       (* Extract outgoing links from Bushel entries *)

     

       133
       122
        
       let update_from_bushel bushel_dir links_file include_domains exclude_domains =

     
···

       297
       286
        
         create_batches_aux links []

     

       298
       287
        
       

     

       299
       288
        
       (* Helper function to upload a single link to Karakeep *)

     

       300
       300
       -
       let upload_single_link api_key base_url tag verbose updated_links link =

     

       289
       289
       +
       let upload_single_link ~sw ~env api_key base_url tag verbose updated_links link =

     

       301
       290
        
         let url = link.Bushel.Link.url in

     

       302
       302
       -
         let title = 

     

       303
       303
       -
           if link.Bushel.Link.description <> "" then 

     

       304
       304
       -
             Some link.Bushel.Link.description 

     

       305
       305
       -
           else None 

     

       291
       291
       +
         let title =

     

       292
       292
       +
           if link.Bushel.Link.description <> "" then

     

       293
       293
       +
             Some link.Bushel.Link.description

     

       294
       294
       +
           else None

     

       306
       295
        
         in

     

       307
       296
        
         let tags = prepare_tags_for_link tag link in

     

       308
       308
       -
         

     

       297
       297
       +
       

     

       309
       298
        
         if verbose then begin

     

       310
       299
        
           log "  Uploading: %s\n" url;

     

       311
       311
       -
           if tags <> [] then 

     

       300
       300
       +
           if tags <> [] then

     

       312
       301
        
             log "    Tags: %s\n" (String.concat ", " tags);

     

       313
       313
       -
           if title <> None then 

     

       302
       302
       +
           if title <> None then

     

       314
       303
        
             log "    Title: %s\n" (Option.get title);

     

       315
       304
        
         end else begin

     

       316
       305
        
           log "Uploading: %s\n" url;

     

       317
       306
        
         end;

     

       318
       318
       -
         

     

       307
       307
       +
       

     

       319
       308
        
         (* Create the bookmark with tags *)

     

       320
       320
       -
         Lwt.catch

     

       321
       321
       -
           (fun () ->

     

       322
       322
       -
             Karakeep.create_bookmark 

     

       323
       323
       -
               ~api_key 

     

       324
       324
       -
               ~url 

     

       325
       325
       -
               ?title 

     

       326
       326
       -
               ~tags 

     

       327
       327
       -
               base_url 

     

       328
       328
       -
             >>= fun bookmark ->

     

       329
       329
       -
             

     

       330
       330
       -
             (* Create updated link with karakeep data *)

     

       331
       331
       -
             let updated_link = {

     

       332
       332
       -
               link with 

     

       333
       333
       -
               Bushel.Link.karakeep = 

     

       334
       334
       -
                 Some { 

     

       335
       335
       -
                   Bushel.Link.remote_url = base_url; 

     

       336
       336
       -
                   id = bookmark.id;

     

       337
       337
       -
                   tags = bookmark.tags;

     

       338
       338
       -
                   metadata = [];  (* Will be populated on next sync *)

     

       339
       339
       -
                 }

     

       340
       340
       -
             } in

     

       341
       341
       -
             updated_links := updated_link :: !updated_links;

     

       342
       342
       -
             

     

       343
       343
       -
             if verbose then

     

       344
       344
       -
               log "    ✓ Added to Karakeep with ID: %s\n" bookmark.id

     

       345
       345
       -
             else

     

       346
       346
       -
               log "  - Added to Karakeep with ID: %s\n" bookmark.id;

     

       347
       347
       -
             Lwt.return 1 (* Success *)

     

       348
       348
       -
           )

     

       349
       349
       -
           (fun exn ->

     

       350
       350
       -
             if verbose then

     

       351
       351
       -
               log "    ✗ Error uploading %s: %s\n" url (Printexc.to_string exn)

     

       352
       352
       -
             else

     

       353
       353
       -
               log "  - Error uploading %s: %s\n" url (Printexc.to_string exn);

     

       354
       354
       -
             Lwt.return 0 (* Failure *)

     

       355
       355
       -
           )

     

       309
       309
       +
         try

     

       310
       310
       +
           let bookmark = Karakeepe.create_bookmark

     

       311
       311
       +
             ~sw ~env

     

       312
       312
       +
             ~api_key

     

       313
       313
       +
             ~url

     

       314
       314
       +
             ?title

     

       315
       315
       +
             ~tags

     

       316
       316
       +
             base_url

     

       317
       317
       +
           in

     

       318
       318
       +
       

     

       319
       319
       +
           (* Create updated link with karakeep data *)

     

       320
       320
       +
           let updated_link = {

     

       321
       321
       +
             link with

     

       322
       322
       +
             Bushel.Link.karakeep =

     

       323
       323
       +
               Some {

     

       324
       324
       +
                 Bushel.Link.remote_url = base_url;

     

       325
       325
       +
                 id = bookmark.id;

     

       326
       326
       +
                 tags = bookmark.tags;

     

       327
       327
       +
                 metadata = [];  (* Will be populated on next sync *)

     

       328
       328
       +
               }

     

       329
       329
       +
           } in

     

       330
       330
       +
           updated_links := updated_link :: !updated_links;

     

       331
       331
       +
       

     

       332
       332
       +
           if verbose then

     

       333
       333
       +
             log "    ✓ Added to Karakeep with ID: %s\n" bookmark.id

     

       334
       334
       +
           else

     

       335
       335
       +
             log "  - Added to Karakeep with ID: %s\n" bookmark.id;

     

       336
       336
       +
           1 (* Success *)

     

       337
       337
       +
         with exn ->

     

       338
       338
       +
           if verbose then

     

       339
       339
       +
             log "    ✗ Error uploading %s: %s\n" url (Printexc.to_string exn)

     

       340
       340
       +
           else

     

       341
       341
       +
             log "  - Error uploading %s: %s\n" url (Printexc.to_string exn);

     

       342
       342
       +
           0 (* Failure *)

     

       356
       343
        
       

     

       357
       344
        
       (* Helper function to process a batch of links *)

     

       358
       358
       -
       let process_batch api_key base_url tag verbose updated_links batch_num total_batches batch =

     

       359
       359
       -
         log_verbose verbose "\nProcessing batch %d/%d (%d links)...\n" 

     

       345
       345
       +
       let process_batch ~sw ~env api_key base_url tag verbose updated_links batch_num total_batches batch =

     

       346
       346
       +
         log_verbose verbose "\nProcessing batch %d/%d (%d links)...\n"

     

       360
       347
        
           (batch_num + 1) total_batches (List.length batch);

     

       361
       361
       -
         

     

       362
       362
       -
         (* Process links in this batch concurrently *)

     

       363
       363
       -
         Lwt_list.map_p (upload_single_link api_key base_url tag verbose updated_links) batch

     

       348
       348
       +
       

     

       349
       349
       +
         (* Process links in this batch in parallel *)

     

       350
       350
       +
         let results = ref [] in

     

       351
       351
       +
         Eio.Fiber.all (List.map (fun link ->

     

       352
       352
       +
           fun () ->

     

       353
       353
       +
             let count = upload_single_link ~sw ~env api_key base_url tag verbose updated_links link in

     

       354
       354
       +
             results := count :: !results

     

       355
       355
       +
         ) batch);

     

       356
       356
       +
         List.rev !results

     

       364
       357
        
       

     

       365
       358
        
       (* Helper function to update links file with new karakeep data *)

     

       366
       359
        
       let update_links_file links_file original_links updated_links =

     
···

       384
       377
        
         end

     

       385
       378
        
       

     

       386
       379
        
       (* Upload links to Karakeep that don't already have karakeep data *)

     

       387
       387
       -
       let upload_to_karakeep base_url api_key_opt links_file tag max_concurrent delay_seconds limit verbose =

     

       380
       380
       +
       let upload_to_karakeep ~sw ~env base_url api_key_opt links_file tag max_concurrent delay_seconds limit verbose =

     

       388
       381
        
         match api_key_opt with

     

       389
       382
        
         | None ->

     

       390
       383
        
             log "Error: API key is required.\n";

     
···

       395
       388
        
             log_verbose verbose "Loading links from %s...\n" links_file;

     

       396
       389
        
             let links = Bushel.Link.load_links_file links_file in

     

       397
       390
        
             log_verbose verbose "Loaded %d total links\n" (List.length links);

     

       398
       398
       -
             

     

       391
       391
       +
       

     

       399
       392
        
             (* Filter links that don't have karakeep data for this remote *)

     

       400
       393
        
             log_verbose verbose "Filtering links that don't have karakeep data for %s...\n" base_url;

     

       401
       394
        
             let filtered_links = filter_links_without_karakeep base_url links in

     

       402
       395
        
             log_verbose verbose "Found %d links without karakeep data\n" (List.length filtered_links);

     

       403
       403
       -
             

     

       396
       396
       +
       

     

       404
       397
        
             (* Apply limit if specified *)

     

       405
       398
        
             let links_to_upload = apply_limit_to_links limit filtered_links in

     

       406
       406
       -
         

     

       399
       399
       +
       

     

       407
       400
        
             if links_to_upload = [] then begin

     

       408
       401
        
               log "No links to upload to %s (all links already have karakeep data)\n" base_url;

     

       409
       402
        
               0

     

       410
       403
        
             end else begin

     

       411
       404
        
               log "Found %d links to upload to %s\n" (List.length links_to_upload) base_url;

     

       412
       412
       -
               

     

       405
       405
       +
       

     

       413
       406
        
               (* Split links into batches for parallel processing *)

     

       414
       407
        
               let batches = create_batches max_concurrent links_to_upload in

     

       415
       415
       -
               log_verbose verbose "Processing in %d batches of up to %d links each...\n" 

     

       408
       408
       +
               log_verbose verbose "Processing in %d batches of up to %d links each...\n"

     

       416
       409
        
                 (List.length batches) max_concurrent;

     

       417
       410
        
               log_verbose verbose "Delay between batches: %.1f seconds\n" delay_seconds;

     

       418
       418
       -
               

     

       411
       411
       +
       

     

       419
       412
        
               (* Process batches and accumulate updated links *)

     

       420
       413
        
               let updated_links = ref [] in

     

       421
       421
       -
               

     

       422
       422
       -
               let result = Lwt_main.run (

     

       423
       423
       -
                 Lwt.catch

     

       424
       424
       -
                   (fun () ->

     

       425
       425
       -
                     Lwt_list.fold_left_s (fun (total_count, batch_num) batch ->

     

       426
       426
       -
                       process_batch api_key base_url tag verbose updated_links 

     

       427
       427
       -
                         batch_num (List.length batches) batch >>= fun results ->

     

       428
       428
       -
                       

     

       414
       414
       +
       

     

       415
       415
       +
               let result = try

     

       416
       416
       +
                 let rec process_batches total_count batch_num = function

     

       417
       417
       +
                   | [] -> total_count

     

       418
       418
       +
                   | batch :: rest ->

     

       419
       419
       +
                       let results = process_batch ~sw ~env api_key base_url tag verbose updated_links

     

       420
       420
       +
                         batch_num (List.length batches) batch in

     

       421
       421
       +
       

     

       429
       422
        
                       (* Count successes in this batch *)

     

       430
       423
        
                       let batch_successes = List.fold_left (+) 0 results in

     

       431
       424
        
                       let new_total = total_count + batch_successes in

     

       432
       432
       -
                       

     

       433
       433
       -
                       log_verbose verbose "  Batch %d complete: %d/%d successful (Total: %d/%d)\n" 

     

       425
       425
       +
       

     

       426
       426
       +
                       log_verbose verbose "  Batch %d complete: %d/%d successful (Total: %d/%d)\n"

     

       434
       427
        
                         (batch_num + 1) batch_successes (List.length batch) new_total (new_total + (List.length links_to_upload - new_total));

     

       435
       435
       -
                       

     

       428
       428
       +
       

     

       436
       429
        
                       (* Add a delay before processing the next batch *)

     

       437
       437
       -
                       if batch_num + 1 < List.length batches then begin

     

       430
       430
       +
                       if rest <> [] then begin

     

       438
       431
        
                         log_verbose verbose "  Waiting %.1f seconds before next batch...\n" delay_seconds;

     

       439
       439
       -
                         Lwt_unix.sleep delay_seconds >>= fun () ->

     

       440
       440
       -
                         Lwt.return (new_total, batch_num + 1)

     

       441
       441
       -
                       end else

     

       442
       442
       -
                         Lwt.return (new_total, batch_num + 1)

     

       443
       443
       -
                     ) (0, 0) batches >>= fun (final_count, _) ->

     

       444
       444
       -
                     Lwt.return final_count

     

       445
       445
       -
                   )

     

       446
       446
       -
                   (fun exn ->

     

       447
       447
       -
                     log "Error during upload operation: %s\n" (Printexc.to_string exn);

     

       448
       448
       -
                     Lwt.return 0

     

       449
       449
       -
                   )

     

       450
       450
       -
               ) in

     

       451
       451
       -
               

     

       432
       432
       +
                         Eio.Time.sleep (Eio.Stdenv.clock env) delay_seconds;

     

       433
       433
       +
                       end;

     

       434
       434
       +
                       process_batches new_total (batch_num + 1) rest

     

       435
       435
       +
                 in

     

       436
       436
       +
                 process_batches 0 0 batches

     

       437
       437
       +
               with exn ->

     

       438
       438
       +
                 log "Error during upload operation: %s\n" (Printexc.to_string exn);

     

       439
       439
       +
                 0

     

       440
       440
       +
               in

     

       441
       441
       +
       

     

       452
       442
        
               (* Update the links file with the new karakeep_ids *)

     

       453
       443
        
               update_links_file links_file links updated_links;

     

       454
       454
       -
               

     

       455
       455
       -
               log "Upload complete. %d/%d links uploaded successfully.\n" 

     

       444
       444
       +
       

     

       445
       445
       +
               log "Upload complete. %d/%d links uploaded successfully.\n"

     

       456
       446
        
                 result (List.length links_to_upload);

     

       457
       457
       -
               

     

       447
       447
       +
       

     

       458
       448
        
               0

     

       459
       449
        
             end

     

       460
       450
        
       

     
···

       527
       517
        
       let karakeep_cmd =

     

       528
       518
        
         let doc = "Update links.yml with links from Karakeep" in

     

       529
       519
        
         let info = Cmd.info "karakeep" ~doc in

     

       530
       530
       -
         Cmd.v info Term.(const update_from_karakeep $ base_url_arg $ api_key_arg $ tag_arg $ links_file_arg $ download_assets_arg)

     

       520
       520
       +
         Cmd.v info Term.(const (fun base_url api_key_opt tag links_file download_assets ->

     

       521
       521
       +
           Eio_main.run @@ fun env ->

     

       522
       522
       +
           Eio.Switch.run @@ fun sw ->

     

       523
       523
       +
           update_from_karakeep ~sw ~env base_url api_key_opt tag links_file download_assets)

     

       524
       524
       +
           $ base_url_arg $ api_key_arg $ tag_arg $ links_file_arg $ download_assets_arg)

     

       531
       525
        
       

     

       532
       526
        
       let bushel_cmd =

     

       533
       527
        
         let doc = "Update links.yml with outgoing links from Bushel entries" in

     
···

       537
       531
        
       let upload_cmd =

     

       538
       532
        
         let doc = "Upload links without karakeep data to Karakeep" in

     

       539
       533
        
         let info = Cmd.info "upload" ~doc in

     

       540
       540
       -
         Cmd.v info Term.(const upload_to_karakeep $ base_url_arg $ api_key_arg $ links_file_arg $ tag_arg $ concurrent_arg $ delay_arg $ limit_arg $ verbose_arg)

     

       534
       534
       +
         Cmd.v info Term.(const (fun base_url api_key_opt links_file tag max_concurrent delay_seconds limit verbose ->

     

       535
       535
       +
           Eio_main.run @@ fun env ->

     

       536
       536
       +
           Eio.Switch.run @@ fun sw ->

     

       537
       537
       +
           upload_to_karakeep ~sw ~env base_url api_key_opt links_file tag max_concurrent delay_seconds limit verbose)

     

       538
       538
       +
           $ base_url_arg $ api_key_arg $ links_file_arg $ tag_arg $ concurrent_arg $ delay_arg $ limit_arg $ verbose_arg)

     

       541
       539
        
       

     

       542
       540
        
       (* Export the term and cmd for use in main bushel.ml *)

     

       543
       541
        
       let cmd =

+12 -10

stack/bushel/bin/bushel_paper.ml

···

       1
       1
        
       module ZT = Zotero_translation

     

       2
       2
       -
       open Lwt.Infix

     

       3
       2
        
       open Printf

     

       4
       3
        
       module J = Ezjsonm

     

       5
       4
        
       open Cmdliner

     
···

       18
       17
        
         J.update j ["author"] (Some (`A a))

     

       19
       18
        
       

     

       20
       19
        
       let of_doi zt ~base_dir ~slug ~version doi =

     

       21
       21
       -
         ZT.json_of_doi zt ~slug doi  >>= fun j ->

     

       20
       20
       +
         let j = ZT.json_of_doi zt ~slug doi in

     

       22
       21
        
         let papers_dir = Printf.sprintf "%s/papers/%s" base_dir slug in

     

       23
       22
        
         (* Ensure papers directory exists *)

     

       24
       23
        
         (try Unix.mkdir papers_dir 0o755 with Unix.Unix_error (Unix.EEXIST, _, _) -> ());

     

       25
       25
       -
         

     

       24
       24
       +
       

     

       26
       25
        
         (* Extract abstract from JSON data *)

     

       27
       26
        
         let abstract = try

     

       28
       27
        
           let keys = Ezjsonm.get_dict (j :> Ezjsonm.value) in

     
···

       30
       29
        
           | Some abstract_json -> Some (Ezjsonm.get_string abstract_json)

     

       31
       30
        
           | None -> None

     

       32
       31
        
         with _ -> None in

     

       33
       33
       -
         

     

       32
       32
       +
       

     

       34
       33
        
         (* Remove abstract from frontmatter - it goes in body *)

     

       35
       34
        
         let keys = Ezjsonm.get_dict (j :> Ezjsonm.value) in

     

       36
       35
        
         let filtered_keys = List.filter (fun (k, _) -> k <> "abstract") keys in

     

       37
       36
        
         let json_without_abstract = `O filtered_keys in

     

       38
       38
       -
         

     

       37
       37
       +
       

     

       39
       38
        
         (* Use library function to generate YAML with abstract in body *)

     

       40
       39
        
         let content = Bushel.Paper.to_yaml ?abstract ~ver:version json_without_abstract in

     

       41
       41
       -
         

     

       40
       40
       +
       

     

       42
       41
        
         let filename = Printf.sprintf "%s.md" version in

     

       43
       42
        
         let filepath = Filename.concat papers_dir filename in

     

       44
       43
        
         let oc = open_out filepath in

     

       45
       44
        
         output_string oc content;

     

       46
       45
        
         close_out oc;

     

       47
       47
       -
         Printf.printf "Created paper file: %s\n" filepath;

     

       48
       48
       -
         Lwt.return ()

     

       46
       46
       +
         Printf.printf "Created paper file: %s\n" filepath

     

       49
       47
        
       

     

       50
       48
        
       let slug_arg =

     

       51
       49
        
         let doc = "Slug for the entry." in

     
···

       62
       60
        
       (* Export the term for use in main bushel.ml *)

     

       63
       61
        
       let term =

     

       64
       62
        
         Term.(const (fun base slug version doi ->

     

       65
       65
       -
           let zt = ZT.v "http://svr-avsm2-eeg-ce:1969" in

     

       66
       66
       -
           Lwt_main.run @@ of_doi zt ~base_dir:base ~slug ~version doi; 0

     

       63
       63
       +
           Eio_main.run @@ fun env ->

     

       64
       64
       +
             Eio.Switch.run @@ fun sw ->

     

       65
       65
       +
               (* Create Zotero Translation client with connection pooling *)

     

       66
       66
       +
               let zt = ZT.create ~sw ~env "http://svr-avsm2-eeg-ce:1969" in

     

       67
       67
       +
               of_doi zt ~base_dir:base ~slug ~version doi;

     

       68
       68
       +
               0

     

       67
       69
        
         ) $ Bushel_common.base_dir $ slug_arg $ version_arg $ doi_arg)

     

       68
       70
        
       

     

       69
       71
        
       let cmd =

+20 -22

stack/bushel/bin/bushel_search.ml

···

       1
       1
        
       open Cmdliner

     

       2
       2
       -
       open Lwt.Syntax

     

       3
       2
        
       

     

       4
       3
        
       (** TODO:claude Bushel search command for integration with main CLI *)

     

       5
       4
        
       

     
···

       42
       41
        
         Printf.printf "Query: \"%s\"\n" query_text;

     

       43
       42
        
         Printf.printf "Limit: %d, Offset: %d\n" limit offset;

     

       44
       43
        
         Printf.printf "\n";

     

       45
       45
       -
         

     

       46
       46
       -
         Lwt_main.run (

     

       47
       47
       -
           Lwt.catch (fun () ->

     

       48
       48
       -
             let* result = Bushel.Typesense.multisearch config query_text ~limit:50 () in

     

       49
       49
       -
             match result with

     

       50
       50
       -
             | Ok multisearch_resp ->

     

       51
       51
       -
               let combined_response = Bushel.Typesense.combine_multisearch_results multisearch_resp ~limit ~offset () in

     

       52
       52
       -
               Printf.printf "Found %d results (%.2fms)\n\n" combined_response.total combined_response.query_time;

     

       53
       53
       -
               

     

       54
       54
       -
               List.iteri (fun i (hit : Bushel.Typesense.search_result) ->

     

       55
       55
       -
                 Printf.printf "%d. %s (score: %.2f)\n" (i + 1) (Bushel.Typesense.pp_search_result_oneline hit) hit.Bushel.Typesense.score

     

       56
       56
       -
               ) combined_response.hits;

     

       57
       57
       -
               Lwt.return_unit

     

       58
       58
       -
             | Error err ->

     

       59
       59
       -
               Format.eprintf "Search error: %a\n" Bushel.Typesense.pp_error err;

     

       60
       60
       -
               exit 1

     

       61
       61
       -
           ) (fun exn ->

     

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

     

       44
       44
       +
       

     

       45
       45
       +
         Eio_main.run @@ fun env ->

     

       46
       46
       +
         Eio.Switch.run @@ fun sw ->

     

       47
       47
       +
         (try

     

       48
       48
       +
           let result = Bushel.Typesense.multisearch ~sw ~env config query_text ~limit:50 () in

     

       49
       49
       +
           match result with

     

       50
       50
       +
           | Ok multisearch_resp ->

     

       51
       51
       +
             let combined_response = Bushel.Typesense.combine_multisearch_results multisearch_resp ~limit ~offset () in

     

       52
       52
       +
             Printf.printf "Found %d results (%.2fms)\n\n" combined_response.total combined_response.query_time;

     

       53
       53
       +
       

     

       54
       54
       +
             List.iteri (fun i (hit : Bushel.Typesense.search_result) ->

     

       55
       55
       +
               Printf.printf "%d. %s (score: %.2f)\n" (i + 1) (Bushel.Typesense.pp_search_result_oneline hit) hit.Bushel.Typesense.score

     

       56
       56
       +
             ) combined_response.hits;

     

       57
       57
       +
             0

     

       58
       58
       +
           | Error err ->

     

       59
       59
       +
             Format.eprintf "Search error: %a\n" Bushel.Typesense.pp_error err;

     

       63
       60
        
             exit 1

     

       64
       64
       -
           )

     

       65
       65
       -
         );

     

       66
       66
       -
         0

     

       61
       61
       +
         with exn ->

     

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

     

       63
       63
       +
           exit 1

     

       64
       64
       +
         )

     

       67
       65
        
       

     

       68
       66
        
       (** TODO:claude Command line term *)

     

       69
       67
        
       let term = Term.(const search $ endpoint $ api_key $ query_text $ limit $ offset)

+53 -57

stack/bushel/bin/bushel_typesense.ml

···

       1
       1
        
       open Cmdliner

     

       2
       2
       -
       open Lwt.Syntax

     

       3
       2
        
       

     

       4
       3
        
       (** TODO:claude Bushel Typesense binary with upload and query functionality *)

     

       5
       4
        
       

     
···

       38
       37
        
       

     

       39
       38
        
         Printf.printf "Uploading bushel data to Typesense at %s\n" endpoint;

     

       40
       39
        
       

     

       41
       41
       -
         Lwt_main.run (

     

       42
       42
       -
           Lwt.catch (fun () ->

     

       43
       43
       -
             Bushel.Typesense.upload_all config entries

     

       44
       44
       -
           ) (fun exn ->

     

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

     

       46
       46
       -
             exit 1

     

       47
       47
       -
           )

     

       40
       40
       +
         Eio_main.run @@ fun env ->

     

       41
       41
       +
         Eio.Switch.run @@ fun sw ->

     

       42
       42
       +
         (try

     

       43
       43
       +
           Bushel.Typesense.upload_all ~sw ~env config entries

     

       44
       44
       +
         with exn ->

     

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

     

       46
       46
       +
           exit 1

     

       48
       47
        
         )

     

       49
       48
        
       

     

       50
       49
        
       

     
···

       67
       66
        
         if collection <> "" then Printf.printf "Collection: %s\n" collection;

     

       68
       67
        
         Printf.printf "Limit: %d, Offset: %d\n" limit offset;

     

       69
       68
        
         Printf.printf "\n";

     

       70
       70
       -
         

     

       71
       71
       -
         Lwt_main.run (

     

       72
       72
       -
           Lwt.catch (fun () ->

     

       73
       73
       -
             let search_fn = if collection = "" then 

     

       74
       74
       -
               Bushel.Typesense.search_all config query_text ~limit ~offset

     

       75
       75
       -
             else

     

       76
       76
       -
               Bushel.Typesense.search_collection config collection query_text ~limit ~offset

     

       77
       77
       -
             in

     

       78
       78
       -
             let* result = search_fn () in

     

       79
       79
       -
             match result with

     

       80
       80
       -
             | Ok response ->

     

       81
       81
       -
               Printf.printf "Found %d results (%.2fms)\n\n" response.total response.query_time;

     

       82
       82
       -
               List.iteri (fun i (hit : Bushel.Typesense.search_result) ->

     

       83
       83
       -
                 Printf.printf "%d. [%s] %s (score: %.2f)\n" (i + 1) hit.collection hit.title hit.score;

     

       84
       84
       -
                 if hit.content <> "" then Printf.printf "   %s\n" hit.content;

     

       85
       85
       -
                 if hit.highlights <> [] then (

     

       86
       86
       -
                   Printf.printf "   Highlights:\n";

     

       87
       87
       -
                   List.iter (fun (field, snippets) ->

     

       88
       88
       -
                     List.iter (fun snippet ->

     

       89
       89
       -
                       Printf.printf "     %s: %s\n" field snippet

     

       90
       90
       -
                     ) snippets

     

       91
       91
       -
                   ) hit.highlights

     

       92
       92
       -
                 );

     

       93
       93
       -
                 Printf.printf "\n"

     

       94
       94
       -
               ) response.hits;

     

       95
       95
       -
               Lwt.return_unit

     

       96
       96
       -
             | Error err ->

     

       97
       97
       -
               Format.eprintf "Search error: %a\n" Bushel.Typesense.pp_error err;

     

       98
       98
       -
               exit 1

     

       99
       99
       -
           ) (fun exn ->

     

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

     

       69
       69
       +
       

     

       70
       70
       +
         Eio_main.run @@ fun env ->

     

       71
       71
       +
         Eio.Switch.run @@ fun sw ->

     

       72
       72
       +
         (try

     

       73
       73
       +
           let result = if collection = "" then

     

       74
       74
       +
             Bushel.Typesense.search_all ~sw ~env config query_text ~limit ~offset ()

     

       75
       75
       +
           else

     

       76
       76
       +
             Bushel.Typesense.search_collection ~sw ~env config collection query_text ~limit ~offset ()

     

       77
       77
       +
           in

     

       78
       78
       +
           match result with

     

       79
       79
       +
           | Ok response ->

     

       80
       80
       +
             Printf.printf "Found %d results (%.2fms)\n\n" response.total response.query_time;

     

       81
       81
       +
             List.iteri (fun i (hit : Bushel.Typesense.search_result) ->

     

       82
       82
       +
               Printf.printf "%d. [%s] %s (score: %.2f)\n" (i + 1) hit.collection hit.title hit.score;

     

       83
       83
       +
               if hit.content <> "" then Printf.printf "   %s\n" hit.content;

     

       84
       84
       +
               if hit.highlights <> [] then (

     

       85
       85
       +
                 Printf.printf "   Highlights:\n";

     

       86
       86
       +
                 List.iter (fun (field, snippets) ->

     

       87
       87
       +
                   List.iter (fun snippet ->

     

       88
       88
       +
                     Printf.printf "     %s: %s\n" field snippet

     

       89
       89
       +
                   ) snippets

     

       90
       90
       +
                 ) hit.highlights

     

       91
       91
       +
               );

     

       92
       92
       +
               Printf.printf "\n"

     

       93
       93
       +
             ) response.hits

     

       94
       94
       +
           | Error err ->

     

       95
       95
       +
             Format.eprintf "Search error: %a\n" Bushel.Typesense.pp_error err;

     

       101
       96
        
             exit 1

     

       102
       102
       -
           )

     

       97
       97
       +
         with exn ->

     

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

     

       99
       99
       +
           exit 1

     

       103
       100
        
         )

     

       104
       101
        
       

     

       105
       102
        
       (** TODO:claude List collections function *)

     
···

       117
       114
        
         );

     

       118
       115
        
         

     

       119
       116
        
         Printf.printf "Listing collections at %s\n\n" config.endpoint;

     

       120
       120
       -
         

     

       121
       121
       -
         Lwt_main.run (

     

       122
       122
       -
           Lwt.catch (fun () ->

     

       123
       123
       -
             let* result = Bushel.Typesense.list_collections config in

     

       124
       124
       -
             match result with

     

       125
       125
       -
             | Ok collections ->

     

       126
       126
       -
               Printf.printf "Collections:\n";

     

       127
       127
       -
               List.iter (fun (name, count) ->

     

       128
       128
       -
                 Printf.printf "  %s (%d documents)\n" name count

     

       129
       129
       -
               ) collections;

     

       130
       130
       -
               Lwt.return_unit

     

       131
       131
       -
             | Error err ->

     

       132
       132
       -
               Format.eprintf "List error: %a\n" Bushel.Typesense.pp_error err;

     

       133
       133
       -
               exit 1

     

       134
       134
       -
           ) (fun exn ->

     

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

     

       117
       117
       +
       

     

       118
       118
       +
         Eio_main.run @@ fun env ->

     

       119
       119
       +
         Eio.Switch.run @@ fun sw ->

     

       120
       120
       +
         (try

     

       121
       121
       +
           let result = Bushel.Typesense.list_collections ~sw ~env config in

     

       122
       122
       +
           match result with

     

       123
       123
       +
           | Ok collections ->

     

       124
       124
       +
             Printf.printf "Collections:\n";

     

       125
       125
       +
             List.iter (fun (name, count) ->

     

       126
       126
       +
               Printf.printf "  %s (%d documents)\n" name count

     

       127
       127
       +
             ) collections

     

       128
       128
       +
           | Error err ->

     

       129
       129
       +
             Format.eprintf "List error: %a\n" Bushel.Typesense.pp_error err;

     

       136
       130
        
             exit 1

     

       137
       137
       -
           )

     

       131
       131
       +
         with exn ->

     

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

     

       133
       133
       +
           exit 1

     

       138
       134
        
         )

     

       139
       135
        
       

     

       140
       136
        
       (** TODO:claude Command line arguments for query *)

+43 -55

stack/bushel/bin/bushel_video.ml

···

       1
       1
        
       [@@@warning "-26-27-32"]

     

       2
       2
        
       

     

       3
       3
       -
       open Lwt.Infix

     

       4
       3
        
       open Cmdliner

     

       5
       4
        
       

     

       6
       5
        
       let setup_log style_renderer level =

     
···

       9
       8
        
         Logs.set_reporter (Logs_fmt.reporter ());

     

       10
       9
        
         ()

     

       11
       10
        
       

     

       12
       12
       -
       let process_videos output_dir overwrite base_url channel fetch_thumbs thumbs_dir =

     

       13
       13
       -
         Peertube.fetch_all_channel_videos base_url channel >>= fun all_videos ->

     

       11
       11
       +
       let process_videos ~sw ~env output_dir overwrite base_url channel fetch_thumbs thumbs_dir =

     

       12
       12
       +
         let all_videos = Peertubee.fetch_all_channel_videos ~sw ~env base_url channel in

     

       14
       13
        
         Logs.info (fun f -> f "Total videos: %d" (List.length all_videos));

     

       15
       14
        
       

     

       16
       15
        
         (* Create thumbnails directory if needed *)

     
···

       18
       17
        
           Unix.mkdir thumbs_dir 0o755);

     

       19
       18
        
       

     

       20
       19
        
         (* Process each video, fetching full details for complete descriptions *)

     

       21
       21
       -
         Lwt_list.map_s (fun video ->

     

       20
       20
       +
         let vids = List.map (fun video ->

     

       22
       21
        
           (* Fetch complete video details to get full description *)

     

       23
       23
       -
           Peertube.fetch_video_details base_url video.Peertube.uuid >>= fun full_video ->

     

       22
       22
       +
           let full_video = Peertubee.fetch_video_details ~sw ~env base_url video.Peertubee.uuid in

     

       24
       23
        
           let (description, published_date, title, url, uuid, slug) =

     

       25
       25
       -
             Peertube.to_bushel_video full_video

     

       24
       24
       +
             Peertubee.to_bushel_video full_video

     

       26
       25
        
           in

     

       27
       26
        
           Logs.info (fun f -> f "Title: %s, URL: %s" title url);

     

       28
       27
        
       

     

       29
       28
        
           (* Download thumbnail if requested *)

     

       30
       29
        
           (if fetch_thumbs then

     

       31
       30
        
             let thumb_path = Filename.concat thumbs_dir (uuid ^ ".jpg") in

     

       32
       32
       -
             Peertube.download_thumbnail base_url full_video thumb_path >>= fun result ->

     

       31
       31
       +
             let result = Peertubee.download_thumbnail ~sw ~env base_url full_video thumb_path in

     

       33
       32
        
             match result with

     

       34
       33
        
             | Ok () ->

     

       35
       35
       -
                 Logs.info (fun f -> f "Downloaded thumbnail for %s to %s" title thumb_path);

     

       36
       36
       -
                 Lwt.return_unit

     

       34
       34
       +
                 Logs.info (fun f -> f "Downloaded thumbnail for %s to %s" title thumb_path)

     

       37
       35
        
             | Error (`Msg e) ->

     

       38
       38
       -
                 Logs.warn (fun f -> f "Failed to download thumbnail for %s: %s" title e);

     

       39
       39
       -
                 Lwt.return_unit

     

       40
       40
       -
           else

     

       41
       41
       -
             Lwt.return_unit) >>= fun () ->

     

       36
       36
       +
                 Logs.warn (fun f -> f "Failed to download thumbnail for %s: %s" title e)

     

       37
       37
       +
           );

     

       38
       38
       +
       

     

       39
       39
       +
           {Bushel.Video.description; published_date; title; url; uuid; slug;

     

       40
       40
       +
            talk=false; paper=None; project=None; tags=full_video.tags}

     

       41
       41
       +
         ) all_videos in

     

       42
       42
        
       

     

       43
       43
       -
           Lwt.return {Bushel.Video.description; published_date; title; url; uuid; slug;

     

       44
       44
       -
                       talk=false; paper=None; project=None; tags=full_video.tags}

     

       45
       45
       -
         ) all_videos >>= fun vids ->

     

       46
       46
       -
         

     

       47
       43
        
         (* Write video files *)

     

       48
       48
       -
         Lwt_list.iter_s (fun video ->

     

       44
       44
       +
         List.iter (fun video ->

     

       49
       45
        
           let file_path = Filename.concat output_dir (video.Bushel.Video.uuid ^ ".md") in

     

       50
       46
        
           let file_exists = Sys.file_exists file_path in

     

       51
       51
       -
           

     

       47
       47
       +
       

     

       52
       48
        
           if file_exists then

     

       53
       49
        
             try

     

       54
       50
        
               (* If file exists, load it to preserve specific fields *)

     
···

       61
       57
        
                 project = existing_video.project;  (* Preserve project field *)

     

       62
       58
        
                 talk = existing_video.talk;  (* Preserve talk field *)

     

       63
       59
        
               } in

     

       64
       64
       -
               

     

       60
       60
       +
       

     

       65
       61
        
               (* Write the merged video data *)

     

       66
       62
        
               if overwrite then

     

       67
       63
        
                 match Bushel.Video.to_file output_dir merged_video with

     

       68
       68
       -
                 | Ok () -> 

     

       69
       69
       -
                     Logs.info (fun f -> f "Updated video %s with preserved fields in %s" 

     

       70
       70
       -
                       merged_video.Bushel.Video.title file_path);

     

       71
       71
       -
                     Lwt.return_unit

     

       72
       72
       -
                 | Error (`Msg e) -> 

     

       73
       73
       -
                     Logs.err (fun f -> f "Failed to update video %s: %s" 

     

       74
       74
       -
                       merged_video.Bushel.Video.title e);

     

       75
       75
       -
                     Lwt.return_unit

     

       76
       76
       -
               else begin

     

       77
       77
       -
                 Logs.info (fun f -> f "Skipping existing video %s (use --overwrite to replace)" 

     

       78
       78
       -
                   video.Bushel.Video.title);

     

       79
       79
       -
                 Lwt.return_unit

     

       80
       80
       -
               end

     

       64
       64
       +
                 | Ok () ->

     

       65
       65
       +
                     Logs.info (fun f -> f "Updated video %s with preserved fields in %s"

     

       66
       66
       +
                       merged_video.Bushel.Video.title file_path)

     

       67
       67
       +
                 | Error (`Msg e) ->

     

       68
       68
       +
                     Logs.err (fun f -> f "Failed to update video %s: %s"

     

       69
       69
       +
                       merged_video.Bushel.Video.title e)

     

       70
       70
       +
               else

     

       71
       71
       +
                 Logs.info (fun f -> f "Skipping existing video %s (use --overwrite to replace)"

     

       72
       72
       +
                   video.Bushel.Video.title)

     

       81
       73
        
             with _ ->

     

       82
       74
        
               (* If reading existing file fails, proceed with new data *)

     

       83
       75
        
               if overwrite then

     

       84
       76
        
                 match Bushel.Video.to_file output_dir video with

     

       85
       85
       -
                 | Ok () -> 

     

       86
       86
       -
                     Logs.info (fun f -> f "Wrote video %s to %s (existing file could not be read)" 

     

       87
       87
       -
                       video.Bushel.Video.title file_path);

     

       88
       88
       -
                     Lwt.return_unit

     

       89
       89
       -
                 | Error (`Msg e) -> 

     

       90
       90
       -
                     Logs.err (fun f -> f "Failed to write video %s: %s" 

     

       91
       91
       -
                       video.Bushel.Video.title e);

     

       92
       92
       -
                     Lwt.return_unit

     

       93
       93
       -
               else begin

     

       94
       94
       -
                 Logs.info (fun f -> f "Skipping existing video %s (use --overwrite to replace)" 

     

       95
       95
       -
                   video.Bushel.Video.title);

     

       96
       96
       -
                 Lwt.return_unit

     

       97
       97
       -
               end

     

       77
       77
       +
                 | Ok () ->

     

       78
       78
       +
                     Logs.info (fun f -> f "Wrote video %s to %s (existing file could not be read)"

     

       79
       79
       +
                       video.Bushel.Video.title file_path)

     

       80
       80
       +
                 | Error (`Msg e) ->

     

       81
       81
       +
                     Logs.err (fun f -> f "Failed to write video %s: %s"

     

       82
       82
       +
                       video.Bushel.Video.title e)

     

       83
       83
       +
               else

     

       84
       84
       +
                 Logs.info (fun f -> f "Skipping existing video %s (use --overwrite to replace)"

     

       85
       85
       +
                   video.Bushel.Video.title)

     

       98
       86
        
           else

     

       99
       87
        
             (* If file doesn't exist, just write new data *)

     

       100
       88
        
             match Bushel.Video.to_file output_dir video with

     

       101
       101
       -
             | Ok () -> 

     

       102
       102
       -
                 Logs.info (fun f -> f "Wrote new video %s to %s" 

     

       103
       103
       -
                   video.Bushel.Video.title file_path);

     

       104
       104
       -
                 Lwt.return_unit

     

       105
       105
       -
             | Error (`Msg e) -> 

     

       106
       106
       -
                 Logs.err (fun f -> f "Failed to write video %s: %s" 

     

       107
       107
       -
                   video.Bushel.Video.title e);

     

       108
       108
       -
                 Lwt.return_unit

     

       89
       89
       +
             | Ok () ->

     

       90
       90
       +
                 Logs.info (fun f -> f "Wrote new video %s to %s"

     

       91
       91
       +
                   video.Bushel.Video.title file_path)

     

       92
       92
       +
             | Error (`Msg e) ->

     

       93
       93
       +
                 Logs.err (fun f -> f "Failed to write video %s: %s"

     

       94
       94
       +
                   video.Bushel.Video.title e)

     

       109
       95
        
         ) vids

     

       110
       96
        
       

     

       111
       97
        
       (* Command line arguments are now imported from Bushel_common *)

     
···

       121
       107
        
           Arg.(value & opt string "images/videos" & info ["thumbs-dir"] ~docv:"DIR" ~doc)

     

       122
       108
        
         in

     

       123
       109
        
         Term.(const (fun output_dir overwrite base_url channel fetch_thumbs thumbs_dir () ->

     

       124
       124
       -
           Lwt_main.run (process_videos output_dir overwrite base_url channel fetch_thumbs thumbs_dir); 0)

     

       110
       110
       +
           Eio_main.run @@ fun env ->

     

       111
       111
       +
           Eio.Switch.run @@ fun sw ->

     

       112
       112
       +
           process_videos ~sw ~env output_dir overwrite base_url channel fetch_thumbs thumbs_dir; 0)

     

       125
       113
        
           $ Bushel_common.output_dir ~default:"." $

     

       126
       114
        
           Bushel_common.overwrite $

     

       127
       115
        
           Bushel_common.url_term ~default:"https://crank.recoil.org" ~doc:"PeerTube base URL" $

+12 -15

stack/bushel/bin/bushel_video_thumbs.ml

···

       1
       1
        
       [@@@warning "-26-27-32"]

     

       2
       2
        
       

     

       3
       3
       -
       open Lwt.Infix

     

       4
       3
        
       open Cmdliner

     

       5
       4
        
       

     

       6
       5
        
       let setup_log style_renderer level =

     
···

       9
       8
        
         Logs.set_reporter (Logs_fmt.reporter ());

     

       10
       9
        
         ()

     

       11
       10
        
       

     

       12
       12
       -
       let process_video_thumbs videos_dir thumbs_dir base_url =

     

       11
       11
       +
       let process_video_thumbs ~sw ~env videos_dir thumbs_dir base_url =

     

       13
       12
        
         (* Ensure thumbnail directory exists *)

     

       14
       13
        
         (if not (Sys.file_exists thumbs_dir) then

     

       15
       14
        
           Unix.mkdir thumbs_dir 0o755);

     
···

       24
       23
        
         Logs.info (fun f -> f "Found %d video files to process" (List.length video_files));

     

       25
       24
        
       

     

       26
       25
        
         (* Process each video file *)

     

       27
       27
       -
         Lwt_list.iter_s (fun video_file ->

     

       26
       26
       +
         List.iter (fun video_file ->

     

       28
       27
        
           try

     

       29
       28
        
             (* Load existing video *)

     

       30
       29
        
             let video = Bushel.Video.of_md video_file in

     
···

       33
       32
        
             Logs.info (fun f -> f "Processing video: %s (UUID: %s)" video.title uuid);

     

       34
       33
        
       

     

       35
       34
        
             (* Fetch video details from PeerTube to get thumbnail info *)

     

       36
       36
       -
             Peertube.fetch_video_details base_url uuid >>= fun peertube_video ->

     

       35
       35
       +
             let peertube_video = Peertubee.fetch_video_details ~sw ~env base_url uuid in

     

       37
       36
        
       

     

       38
       37
        
             (* Download thumbnail *)

     

       39
       38
        
             let thumb_path = Filename.concat thumbs_dir (uuid ^ ".jpg") in

     

       40
       40
       -
             Peertube.download_thumbnail base_url peertube_video thumb_path >>= fun result ->

     

       39
       39
       +
             let result = Peertubee.download_thumbnail ~sw ~env base_url peertube_video thumb_path in

     

       41
       40
        
       

     

       42
       41
        
             match result with

     

       43
       42
        
             | Ok () ->

     

       44
       43
        
                 Logs.info (fun f -> f "Downloaded thumbnail for %s to %s" video.title thumb_path);

     

       45
       44
        
       

     

       46
       45
        
                 (* Update video file with thumbnail_url field *)

     

       47
       47
       -
                 (match Peertube.thumbnail_url base_url peertube_video with

     

       46
       46
       +
                 (match Peertubee.thumbnail_url base_url peertube_video with

     

       48
       47
        
                  | Some url ->

     

       49
       49
       -
                      Logs.info (fun f -> f "Thumbnail URL: %s" url);

     

       50
       50
       -
                      Lwt.return_unit

     

       48
       48
       +
                      Logs.info (fun f -> f "Thumbnail URL: %s" url)

     

       51
       49
        
                  | None ->

     

       52
       52
       -
                      Logs.warn (fun f -> f "No thumbnail URL for video %s" video.title);

     

       53
       53
       -
                      Lwt.return_unit)

     

       50
       50
       +
                      Logs.warn (fun f -> f "No thumbnail URL for video %s" video.title))

     

       54
       51
        
             | Error (`Msg e) ->

     

       55
       55
       -
                 Logs.err (fun f -> f "Failed to download thumbnail for %s: %s" video.title e);

     

       56
       56
       -
                 Lwt.return_unit

     

       52
       52
       +
                 Logs.err (fun f -> f "Failed to download thumbnail for %s: %s" video.title e)

     

       57
       53
        
           with exn ->

     

       58
       58
       -
             Logs.err (fun f -> f "Error processing %s: %s" video_file (Printexc.to_string exn));

     

       59
       59
       -
             Lwt.return_unit

     

       54
       54
       +
             Logs.err (fun f -> f "Error processing %s: %s" video_file (Printexc.to_string exn))

     

       60
       55
        
         ) video_files

     

       61
       56
        
       

     

       62
       57
        
       let term =

     
···

       69
       64
        
           Arg.(value & opt string "images/videos" & info ["thumbs-dir"; "t"] ~docv:"DIR" ~doc)

     

       70
       65
        
         in

     

       71
       66
        
         Term.(const (fun videos_dir thumbs_dir base_url () ->

     

       72
       72
       -
           Lwt_main.run (process_video_thumbs videos_dir thumbs_dir base_url); 0)

     

       67
       67
       +
           Eio_main.run @@ fun env ->

     

       68
       68
       +
           Eio.Switch.run @@ fun sw ->

     

       69
       69
       +
           process_video_thumbs ~sw ~env videos_dir thumbs_dir base_url; 0)

     

       73
       70
        
           $ videos_dir $

     

       74
       71
        
           thumbs_dir $

     

       75
       72
        
           Bushel_common.url_term ~default:"https://crank.recoil.org" ~doc:"PeerTube base URL" $

+2 -2

stack/bushel/bin/dune

···

       9
       9
        
        (package bushel)

     

       10
       10
        
        (modules bushel_main bushel_bibtex bushel_doi bushel_ideas bushel_info bushel_missing bushel_note_doi bushel_obsidian bushel_paper bushel_paper_classify bushel_paper_tex bushel_video bushel_video_thumbs bushel_thumbs bushel_faces bushel_links bushel_search)

     

       11
       11
        
        (flags (:standard -w -69))

     

       12
       12
       -
        (libraries bushel bushel_common cmdliner cohttp-lwt-unix lwt.unix yaml ezjsonm zotero-translation peertube fmt fmt.cli fmt.tty logs logs.cli logs.fmt cmarkit karakeep uri unix ptime.clock.os crockford))

     

       12
       12
       +
        (libraries bushel bushel_common cmdliner eio eio_main yaml ezjsonm zotero-translation peertubee fmt fmt.cli fmt.tty logs logs.cli logs.fmt cmarkit karakeepe uri unix ptime.clock.os crockford immiche))

     

       13
       13
        
       

     

       14
       14
        
       (executable

     

       15
       15
        
        (name bushel_typesense)

     
···

       17
       17
        
        (package bushel)

     

       18
       18
        
        (modules bushel_typesense)

     

       19
       19
        
        (flags (:standard -w -69))

     

       20
       20
       -
        (libraries bushel bushel_common cmdliner lwt.unix))

     

       20
       20
       +
        (libraries bushel bushel_common cmdliner eio eio_main))

+7 -5

stack/bushel/bushel.opam

···

       18
       18
        
         "bytesrw"

     

       19
       19
        
         "jekyll-format"

     

       20
       20
        
         "yaml"

     

       21
       21
       -
         "lwt"

     

       22
       22
       -
         "cohttp-lwt-unix"

     

       21
       21
       +
         "eio"

     

       22
       22
       +
         "eio_main"

     

       23
       23
       +
         "requests"

     

       23
       24
        
         "fmt"

     

       24
       24
       -
         "peertube"

     

       25
       25
       -
         "karakeep"

     

       26
       26
       -
         "typesense-client"

     

       25
       25
       +
         "peertubee"

     

       26
       26
       +
         "karakeepe"

     

       27
       27
       +
         "typesense-cliente"

     

       28
       28
       +
         "immiche"

     

       27
       29
        
         "cmdliner" {>= "2.0.0"}

     

       28
       30
        
         "odoc" {with-doc}

     

       29
       31
        
       ]

+7 -42

stack/bushel/dune-project

···

       22
       22
        
         bytesrw

     

       23
       23
        
         jekyll-format

     

       24
       24
        
         yaml

     

       25
       25
       -
         lwt

     

       26
       26
       -
         cohttp-lwt-unix

     

       25
       25
       +
         eio

     

       26
       26
       +
         eio_main

     

       27
       27
       +
         requests

     

       27
       28
        
         fmt

     

       28
       28
       -
         peertube

     

       29
       29
       -
         karakeep

     

       30
       30
       -
         typesense-client

     

       29
       29
       +
         peertubee

     

       30
       30
       +
         karakeepe

     

       31
       31
       +
         typesense-cliente

     

       32
       32
       +
         immiche

     

       31
       33
        
         (cmdliner (>= 2.0.0))))

     

       32
       32
       -
       

     

       33
       33
       -
       (package

     

       34
       34
       -
        (name peertube)

     

       35
       35
       -
        (synopsis "PeerTube API client")

     

       36
       36
       -
        (description "Client for interacting with PeerTube instances")

     

       37
       37
       -
        (depends

     

       38
       38
       -
         (ocaml (>= "5.2.0"))

     

       39
       39
       -
         ezjsonm

     

       40
       40
       -
         lwt

     

       41
       41
       -
         cohttp-lwt-unix

     

       42
       42
       -
         ptime

     

       43
       43
       -
         fmt))

     

       44
       44
       -
       

     

       45
       45
       -
       (package

     

       46
       46
       -
        (name karakeep)

     

       47
       47
       -
        (synopsis "Karakeep API client for Bushel")

     

       48
       48
       -
        (description "Karakeep API client to retrieve bookmarks from Karakeep instances")

     

       49
       49
       -
        (depends

     

       50
       50
       -
         (ocaml (>= "5.2.0"))

     

       51
       51
       -
         ezjsonm

     

       52
       52
       -
         lwt

     

       53
       53
       -
         cohttp-lwt-unix

     

       54
       54
       -
         ptime

     

       55
       55
       -
         fmt))

     

       56
       56
       -
       

     

       57
       57
       -
       (package

     

       58
       58
       -
        (name typesense-client)

     

       59
       59
       -
        (synopsis "Standalone Typesense client for OCaml")

     

       60
       60
       -
        (description "A standalone Typesense client that can be compiled to JavaScript")

     

       61
       61
       -
        (depends

     

       62
       62
       -
         (ocaml (>= "5.2.0"))

     

       63
       63
       -
         ezjsonm

     

       64
       64
       -
         lwt

     

       65
       65
       -
         cohttp-lwt-unix

     

       66
       66
       -
         ptime

     

       67
       67
       -
         fmt

     

       68
       68
       -
         uri))

-35

stack/bushel/karakeep.opam

···

       1
       1
       -
       # This file is generated by dune, edit dune-project instead

     

       2
       2
       -
       opam-version: "2.0"

     

       3
       3
       -
       synopsis: "Karakeep API client for Bushel"

     

       4
       4
       -
       description:

     

       5
       5
       -
         "Karakeep API client to retrieve bookmarks from Karakeep instances"

     

       6
       6
       -
       maintainer: ["anil@recoil.org"]

     

       7
       7
       -
       authors: ["Anil Madhavapeddy"]

     

       8
       8
       -
       license: "ISC"

     

       9
       9
       -
       homepage: "https://github.com/avsm/bushel"

     

       10
       10
       -
       bug-reports: "https://github.com/avsm/bushel/issues"

     

       11
       11
       -
       depends: [

     

       12
       12
       -
         "dune" {>= "3.17"}

     

       13
       13
       -
         "ocaml" {>= "5.2.0"}

     

       14
       14
       -
         "ezjsonm"

     

       15
       15
       -
         "lwt"

     

       16
       16
       -
         "cohttp-lwt-unix"

     

       17
       17
       -
         "ptime"

     

       18
       18
       -
         "fmt"

     

       19
       19
       -
         "odoc" {with-doc}

     

       20
       20
       -
       ]

     

       21
       21
       -
       build: [

     

       22
       22
       -
         ["dune" "subst"] {dev}

     

       23
       23
       -
         [

     

       24
       24
       -
           "dune"

     

       25
       25
       -
           "build"

     

       26
       26
       -
           "-p"

     

       27
       27
       -
           name

     

       28
       28
       -
           "-j"

     

       29
       29
       -
           jobs

     

       30
       30
       -
           "@install"

     

       31
       31
       -
           "@runtest" {with-test}

     

       32
       32
       -
           "@doc" {with-doc}

     

       33
       33
       -
         ]

     

       34
       34
       -
       ]

     

       35
       35
       -
       dev-repo: "git+https://github.com/avsm/bushel.git"

-4

stack/bushel/karakeep/dune

···

       1
       1
       -
       (library

     

       2
       2
       -
        (name karakeep) 

     

       3
       3
       -
        (public_name karakeep)

     

       4
       4
       -
        (libraries bushel lwt cohttp cohttp-lwt-unix ezjsonm fmt ptime))

-568

stack/bushel/karakeep/karakeep.ml

···

       1
       1
       -
       (** Karakeep API client implementation *)

     

       2
       2
       -
       

     

       3
       3
       -
       open Lwt.Infix

     

       4
       4
       -
       

     

       5
       5
       -
       module J = Ezjsonm

     

       6
       6
       -
       

     

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

     

       8
       8
       -
       type bookmark = {

     

       9
       9
       -
         id: string;

     

       10
       10
       -
         title: string option;

     

       11
       11
       -
         url: string;

     

       12
       12
       -
         note: string option;

     

       13
       13
       -
         created_at: Ptime.t;

     

       14
       14
       -
         updated_at: Ptime.t option;

     

       15
       15
       -
         favourited: bool;

     

       16
       16
       -
         archived: bool;

     

       17
       17
       -
         tags: string list;

     

       18
       18
       -
         tagging_status: string option;

     

       19
       19
       -
         summary: string option;

     

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

     

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

     

       22
       22
       -
       }

     

       23
       23
       -
       

     

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

     

       25
       25
       -
       type bookmark_response = {

     

       26
       26
       -
         total: int;

     

       27
       27
       -
         data: bookmark list;

     

       28
       28
       -
         next_cursor: string option;

     

       29
       29
       -
       }

     

       30
       30
       -
       

     

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

     

       32
       32
       -
       let parse_date str =

     

       33
       33
       -
         match Ptime.of_rfc3339 str with

     

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

     

       35
       35
       -
         | Error _ -> 

     

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

     

       37
       37
       -
             (* Default to epoch time *)

     

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

     

       39
       39
       -
             match span_opt with

     

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

     

       41
       41
       -
             | Some span ->

     

       42
       42
       -
               match Ptime.of_span span with

     

       43
       43
       -
               | Some t -> t

     

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

     

       45
       45
       -
       

     

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

     

       47
       47
       -
       let get_string_opt json path =

     

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

     

       49
       49
       -
         with _ -> None

     

       50
       50
       -
       

     

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

     

       52
       52
       -
       let get_string_list json path =

     

       53
       53
       -
         try 

     

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

     

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

     

       56
       56
       -
         with _ -> []

     

       57
       57
       -
       

     

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

     

       59
       59
       -
       let get_bool_def json path default =

     

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

     

       61
       61
       -
         with _ -> default

     

       62
       62
       -
       

     

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

     

       64
       64
       -
       let parse_bookmark json =

     

       65
       65
       -
         (* Remove debug prints for production *)

     

       66
       66
       -
         (* Printf.eprintf "%s\n%!" (J.value_to_string json); *)

     

       67
       67
       -
         

     

       68
       68
       -
         let id = 

     

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

     

       70
       70
       -
           with e -> 

     

       71
       71
       -
             prerr_endline (Fmt.str "Error parsing bookmark ID: %s" (Printexc.to_string e));

     

       72
       72
       -
             prerr_endline (Fmt.str "JSON: %s" (J.value_to_string json));

     

       73
       73
       -
             failwith "Unable to parse bookmark ID"

     

       74
       74
       -
         in

     

       75
       75
       -
         

     

       76
       76
       -
         (* Title can be null *)

     

       77
       77
       -
         let title = 

     

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

     

       79
       79
       -
           with _ -> None

     

       80
       80
       -
         in

     

       81
       81
       -
         (* Remove debug prints for production *)

     

       82
       82
       -
         (* Printf.eprintf "%s -> %s\n%!" id (match title with None -> "???"  | Some v -> v); *)

     

       83
       83
       -
         (* Get URL - try all possible locations *)

     

       84
       84
       -
         let url = 

     

       85
       85
       -
           try J.find json ["url"] |> J.get_string  (* Direct url field *)

     

       86
       86
       -
           with _ -> try

     

       87
       87
       -
             J.find json ["content"; "url"] |> J.get_string  (* Inside content.url *)

     

       88
       88
       -
           with _ -> try

     

       89
       89
       -
             J.find json ["content"; "sourceUrl"] |> J.get_string  (* Inside content.sourceUrl *)

     

       90
       90
       -
           with _ -> 

     

       91
       91
       -
             (* For assets/PDF type links *)

     

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

     

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

     

       94
       94
       -
                 (* Extract URL from sourceUrl in content *)

     

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

     

       96
       96
       -
                  with _ -> 

     

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

     

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

     

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

     

       100
       100
       -
             | _ ->

     

       101
       101
       -
                 (* Debug output to understand what we're getting *)

     

       102
       102
       -
                 prerr_endline (Fmt.str "Bookmark JSON structure: %s" (J.value_to_string json));

     

       103
       103
       -
                 failwith "No URL found in bookmark"

     

       104
       104
       -
         in

     

       105
       105
       -
         

     

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

     

       107
       107
       -
         

     

       108
       108
       -
         (* Parse dates *)

     

       109
       109
       -
         let created_at = 

     

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

     

       111
       111
       -
           with _ -> 

     

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

     

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

     

       114
       114
       -
         in

     

       115
       115
       -
         

     

       116
       116
       -
         let updated_at = 

     

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

     

       118
       118
       -
           with _ -> 

     

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

     

       120
       120
       -
             with _ -> None

     

       121
       121
       -
         in

     

       122
       122
       -
         

     

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

     

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

     

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

     

       126
       126
       -
         

     

       127
       127
       -
         (* Extract additional metadata *)

     

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

     

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

     

       130
       130
       -
         

     

       131
       131
       -
         (* Extract content details *)

     

       132
       132
       -
         let content =

     

       133
       133
       -
           try

     

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

     

       135
       135
       -
             let rec extract_fields acc = function

     

       136
       136
       -
               | [] -> acc

     

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

     

       138
       138
       -
                   let value = match v with

     

       139
       139
       -
                     | `String s -> s

     

       140
       140
       -
                     | `Bool b -> string_of_bool b

     

       141
       141
       -
                     | `Float f -> string_of_float f

     

       142
       142
       -
                     | `Null -> "null"

     

       143
       143
       -
                     | _ -> "complex_value" (* For objects and arrays *)

     

       144
       144
       -
                   in

     

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

     

       146
       146
       -
             in

     

       147
       147
       -
             match content_json with

     

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

     

       149
       149
       -
             | _ -> []

     

       150
       150
       -
           with _ -> []

     

       151
       151
       -
         in

     

       152
       152
       -
         

     

       153
       153
       -
         (* Extract assets *)

     

       154
       154
       -
         let assets =

     

       155
       155
       -
           try

     

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

     

       157
       157
       -
             J.get_list (fun asset_json ->

     

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

     

       159
       159
       -
               let asset_type = 

     

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

     

       161
       161
       -
                 with _ -> "unknown"

     

       162
       162
       -
               in

     

       163
       163
       -
               (id, asset_type)

     

       164
       164
       -
             ) assets_json

     

       165
       165
       -
           with _ -> []

     

       166
       166
       -
         in

     

       167
       167
       -
         

     

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

     

       169
       169
       -
           tagging_status; summary; content; assets }

     

       170
       170
       -
       

     

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

     

       172
       172
       -
       let parse_bookmark_response json =

     

       173
       173
       -
         (* The response format is different based on endpoint, need to handle both structures *)

     

       174
       174
       -
         (* Print the whole JSON structure for debugging *)

     

       175
       175
       -
         prerr_endline (Fmt.str "Full response JSON: %s" (J.value_to_string json));

     

       176
       176
       -
         

     

       177
       177
       -
         try 

     

       178
       178
       -
           (* Standard list format with total count *)

     

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

     

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

     

       181
       181
       -
           prerr_endline "Found bookmarks in data array";

     

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

     

       183
       183
       -
           

     

       184
       184
       -
           (* Try to extract nextCursor if available *)

     

       185
       185
       -
           let next_cursor = 

     

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

     

       187
       187
       -
             with _ -> None

     

       188
       188
       -
           in

     

       189
       189
       -
           

     

       190
       190
       -
           { total; data; next_cursor }

     

       191
       191
       -
         with e1 -> 

     

       192
       192
       -
           prerr_endline (Fmt.str "First format parse error: %s" (Printexc.to_string e1));

     

       193
       193
       -
           try

     

       194
       194
       -
             (* Format with bookmarks array *)

     

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

     

       196
       196
       -
             prerr_endline "Found bookmarks in bookmarks array";

     

       197
       197
       -
             let data = 

     

       198
       198
       -
               try J.get_list parse_bookmark bookmarks_json 

     

       199
       199
       -
               with e ->

     

       200
       200
       -
                 prerr_endline (Fmt.str "Error parsing bookmarks array: %s" (Printexc.to_string e));

     

       201
       201
       -
                 prerr_endline (Fmt.str "First bookmark sample: %s" 

     

       202
       202
       -
                   (try J.value_to_string (List.hd (J.get_list (fun x -> x) bookmarks_json))

     

       203
       203
       -
                    with _ -> "Could not extract sample"));

     

       204
       204
       -
                 []

     

       205
       205
       -
             in

     

       206
       206
       -
             

     

       207
       207
       -
             (* Try to extract nextCursor if available *)

     

       208
       208
       -
             let next_cursor = 

     

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

     

       210
       210
       -
               with _ -> None

     

       211
       211
       -
             in

     

       212
       212
       -
             

     

       213
       213
       -
             { total = List.length data; data; next_cursor }

     

       214
       214
       -
           with e2 ->

     

       215
       215
       -
             prerr_endline (Fmt.str "Second format parse error: %s" (Printexc.to_string e2));

     

       216
       216
       -
             try

     

       217
       217
       -
               (* Check if it's an error response *)

     

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

     

       219
       219
       -
               let message = 

     

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

     

       221
       221
       -
                 with _ -> "Unknown error"

     

       222
       222
       -
               in

     

       223
       223
       -
               prerr_endline (Fmt.str "API Error: %s - %s" error message);

     

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

     

       225
       225
       -
             with _ ->

     

       226
       226
       -
               try

     

       227
       227
       -
                 (* Alternate format without total (for endpoints like /tags/<id>/bookmarks) *)

     

       228
       228
       -
                 prerr_endline "Trying alternate array format";

     

       229
       229
       -
                 

     

       230
       230
       -
                 (* Debug the structure to identify the format *)

     

       231
       231
       -
                 prerr_endline (Fmt.str "JSON structure keys: %s" 

     

       232
       232
       -
                   (match json with

     

       233
       233
       -
                    | `O fields -> 

     

       234
       234
       -
                        String.concat ", " (List.map (fun (k, _) -> k) fields)

     

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

     

       236
       236
       -
                 

     

       237
       237
       -
                 (* Check if it has a nextCursor but bookmarks are nested differently *)

     

       238
       238
       -
                 if J.find_opt json ["nextCursor"] <> None then begin

     

       239
       239
       -
                   prerr_endline "Found nextCursor, checking alternate structures";

     

       240
       240
       -
                   

     

       241
       241
       -
                   (* Try different bookmark container paths *)

     

       242
       242
       -
                   let bookmarks_json =

     

       243
       243
       -
                     try Some (J.find json ["data"])

     

       244
       244
       -
                     with _ -> None

     

       245
       245
       -
                   in

     

       246
       246
       -
                   

     

       247
       247
       -
                   match bookmarks_json with

     

       248
       248
       -
                   | Some json_array ->

     

       249
       249
       -
                       prerr_endline "Found bookmarks in data field";

     

       250
       250
       -
                       begin try

     

       251
       251
       -
                         let data = J.get_list parse_bookmark json_array in

     

       252
       252
       -
                         let next_cursor = 

     

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

     

       254
       254
       -
                           with _ -> None

     

       255
       255
       -
                         in

     

       256
       256
       -
                         { total = List.length data; data; next_cursor }

     

       257
       257
       -
                       with e ->

     

       258
       258
       -
                         prerr_endline (Fmt.str "Error parsing bookmarks from data: %s" (Printexc.to_string e));

     

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

     

       260
       260
       -
                       end

     

       261
       261
       -
                   | None ->

     

       262
       262
       -
                       prerr_endline "No bookmarks found in alternate structure";

     

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

     

       264
       264
       -
                 end

     

       265
       265
       -
                 else begin

     

       266
       266
       -
                   (* Check if it's an array at root level *)

     

       267
       267
       -
                   match json with

     

       268
       268
       -
                   | `A _ ->

     

       269
       269
       -
                       let data = 

     

       270
       270
       -
                         try J.get_list parse_bookmark json

     

       271
       271
       -
                         with e ->

     

       272
       272
       -
                           prerr_endline (Fmt.str "Error parsing root array: %s" (Printexc.to_string e));

     

       273
       273
       -
                           []

     

       274
       274
       -
                       in

     

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

     

       276
       276
       -
                   | _ -> 

     

       277
       277
       -
                       prerr_endline "Not an array at root level";

     

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

     

       279
       279
       -
                 end

     

       280
       280
       -
               with e3 ->

     

       281
       281
       -
                 prerr_endline (Fmt.str "Third format parse error: %s" (Printexc.to_string e3));

     

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

     

       283
       283
       -
       

     

       284
       284
       -
       (** Helper function to consume and return response body data *)

     

       285
       285
       -
       let consume_body body =

     

       286
       286
       -
         Cohttp_lwt.Body.to_string body >>= fun _ ->

     

       287
       287
       -
         Lwt.return_unit

     

       288
       288
       -
       

     

       289
       289
       -
       (** Fetch bookmarks from a Karakeep instance with pagination support *)

     

       290
       290
       -
       let fetch_bookmarks ~api_key ?(limit=50) ?(offset=0) ?cursor ?(include_content=false) ?filter_tags base_url =

     

       291
       291
       -
         let open Cohttp_lwt_unix in

     

       292
       292
       -
         

     

       293
       293
       -
         (* Base URL for bookmarks API *)

     

       294
       294
       -
         let url_base = Fmt.str "%s/api/v1/bookmarks?limit=%d&includeContent=%b" 

     

       295
       295
       -
                         base_url limit include_content in

     

       296
       296
       -
         

     

       297
       297
       -
         (* Add pagination parameter - either cursor or offset *)

     

       298
       298
       -
         let url = 

     

       299
       299
       -
           match cursor with

     

       300
       300
       -
           | Some cursor_value -> 

     

       301
       301
       -
               url_base ^ "&cursor=" ^ cursor_value

     

       302
       302
       -
           | None -> 

     

       303
       303
       -
               url_base ^ "&offset=" ^ string_of_int offset

     

       304
       304
       -
         in

     

       305
       305
       -
         

     

       306
       306
       -
         (* Add tags filter if provided *)

     

       307
       307
       -
         let url = match filter_tags with

     

       308
       308
       -
           | Some tags when tags <> [] -> 

     

       309
       309
       -
               (* URL encode each tag and join with commas *)

     

       310
       310
       -
               let encoded_tags = 

     

       311
       311
       -
                 List.map (fun tag -> 

     

       312
       312
       -
                   Uri.pct_encode ~component:`Query_key tag

     

       313
       313
       -
                 ) tags 

     

       314
       314
       -
               in

     

       315
       315
       -
               let tags_param = String.concat "," encoded_tags in

     

       316
       316
       -
               prerr_endline (Fmt.str "Adding tags filter: %s" tags_param);

     

       317
       317
       -
               url ^ "&tags=" ^ tags_param

     

       318
       318
       -
           | _ -> url

     

       319
       319
       -
         in

     

       320
       320
       -
         

     

       321
       321
       -
         (* Set up headers with API key *)

     

       322
       322
       -
         let headers = Cohttp.Header.init ()

     

       323
       323
       -
           |> fun h -> Cohttp.Header.add h "Authorization" ("Bearer " ^ api_key) in

     

       324
       324
       -
         

     

       325
       325
       -
         prerr_endline (Fmt.str "Fetching bookmarks from: %s" url);

     

       326
       326
       -
       

     

       327
       327
       -
         (* Make the request *)

     

       328
       328
       -
         Lwt.catch

     

       329
       329
       -
           (fun () ->

     

       330
       330
       -
             Client.get ~headers (Uri.of_string url) >>= fun (resp, body) ->

     

       331
       331
       -
             if resp.status = `OK then

     

       332
       332
       -
               Cohttp_lwt.Body.to_string body >>= fun body_str ->

     

       333
       333
       -
               prerr_endline (Fmt.str "Received %d bytes of response data" (String.length body_str));

     

       334
       334
       -
               

     

       335
       335
       -
               Lwt.catch

     

       336
       336
       -
                 (fun () ->

     

       337
       337
       -
                   let json = J.from_string body_str in

     

       338
       338
       -
                   Lwt.return (parse_bookmark_response json)

     

       339
       339
       -
                 )

     

       340
       340
       -
                 (fun e ->

     

       341
       341
       -
                   prerr_endline (Fmt.str "JSON parsing error: %s" (Printexc.to_string e));

     

       342
       342
       -
                   prerr_endline (Fmt.str "Response body (first 200 chars): %s" 

     

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

     

       344
       344
       -
                   Lwt.fail e

     

       345
       345
       -
                 )

     

       346
       346
       -
             else

     

       347
       347
       -
               let status_code = Cohttp.Code.code_of_status resp.status in

     

       348
       348
       -
               consume_body body >>= fun _ ->

     

       349
       349
       -
               prerr_endline (Fmt.str "HTTP error %d" status_code);

     

       350
       350
       -
               Lwt.fail_with (Fmt.str "HTTP error: %d" status_code)

     

       351
       351
       -
           )

     

       352
       352
       -
           (fun e ->

     

       353
       353
       -
             prerr_endline (Fmt.str "Network error: %s" (Printexc.to_string e));

     

       354
       354
       -
             Lwt.fail e

     

       355
       355
       -
           )

     

       356
       356
       -
       

     

       357
       357
       -
       (** Fetch all bookmarks from a Karakeep instance using pagination *)

     

       358
       358
       -
       let fetch_all_bookmarks ~api_key ?(page_size=50) ?max_pages ?filter_tags ?(include_content=false) base_url =

     

       359
       359
       -
         let rec fetch_pages page_num cursor acc _total_count =

     

       360
       360
       -
           (* Use cursor if available, otherwise use offset-based pagination *)

     

       361
       361
       -
           (match cursor with

     

       362
       362
       -
            | Some cursor_str -> fetch_bookmarks ~api_key ~limit:page_size ~cursor:cursor_str ~include_content ?filter_tags base_url 

     

       363
       363
       -
            | None -> fetch_bookmarks ~api_key ~limit:page_size ~offset:(page_num * page_size) ~include_content ?filter_tags base_url)

     

       364
       364
       -
           >>= fun response ->

     

       365
       365
       -
           

     

       366
       366
       -
           let all_bookmarks = acc @ response.data in

     

       367
       367
       -
           

     

       368
       368
       -
           (* Determine if we need to fetch more pages *)

     

       369
       369
       -
           let more_available = 

     

       370
       370
       -
             match response.next_cursor with

     

       371
       371
       -
             | Some _ -> true  (* We have a cursor, so there are more results *)

     

       372
       372
       -
             | None -> 

     

       373
       373
       -
                 (* Fall back to offset-based check *)

     

       374
       374
       -
                 let fetched_count = (page_num * page_size) + List.length response.data in

     

       375
       375
       -
                 fetched_count < response.total

     

       376
       376
       -
           in

     

       377
       377
       -
           

     

       378
       378
       -
           let under_max_pages = match max_pages with

     

       379
       379
       -
             | None -> true

     

       380
       380
       -
             | Some max -> page_num + 1 < max

     

       381
       381
       -
           in

     

       382
       382
       -
           

     

       383
       383
       -
           if more_available && under_max_pages then

     

       384
       384
       -
             fetch_pages (page_num + 1) response.next_cursor all_bookmarks response.total

     

       385
       385
       -
           else

     

       386
       386
       -
             Lwt.return all_bookmarks

     

       387
       387
       -
         in

     

       388
       388
       -
         fetch_pages 0 None [] 0

     

       389
       389
       -
       

     

       390
       390
       -
       (** Fetch detailed information for a single bookmark by ID *)

     

       391
       391
       -
       let fetch_bookmark_details ~api_key base_url bookmark_id =

     

       392
       392
       -
         let open Cohttp_lwt_unix in

     

       393
       393
       -
         let url = Fmt.str "%s/api/v1/bookmarks/%s" base_url bookmark_id in

     

       394
       394
       -
         

     

       395
       395
       -
         (* Set up headers with API key *)

     

       396
       396
       -
         let headers = Cohttp.Header.init ()

     

       397
       397
       -
           |> fun h -> Cohttp.Header.add h "Authorization" ("Bearer " ^ api_key) in

     

       398
       398
       -
           

     

       399
       399
       -
         Client.get ~headers (Uri.of_string url) >>= fun (resp, body) ->

     

       400
       400
       -
         if resp.status = `OK then

     

       401
       401
       -
           Cohttp_lwt.Body.to_string body >>= fun body_str ->

     

       402
       402
       -
           let json = J.from_string body_str in

     

       403
       403
       -
           Lwt.return (parse_bookmark json)

     

       404
       404
       -
         else

     

       405
       405
       -
           let status_code = Cohttp.Code.code_of_status resp.status in

     

       406
       406
       -
           consume_body body >>= fun () ->

     

       407
       407
       -
           Lwt.fail_with (Fmt.str "HTTP error: %d" status_code)

     

       408
       408
       -
       

     

       409
       409
       -
       (** Get the asset URL for a given asset ID *)

     

       410
       410
       -
       let get_asset_url base_url asset_id =

     

       411
       411
       -
         Fmt.str "%s/api/assets/%s" base_url asset_id

     

       412
       412
       -
       

     

       413
       413
       -
       (** Fetch an asset from the Karakeep server as a binary string *)

     

       414
       414
       -
       let fetch_asset ~api_key base_url asset_id =

     

       415
       415
       -
         let open Cohttp_lwt_unix in

     

       416
       416
       -
         

     

       417
       417
       -
         let url = get_asset_url base_url asset_id in

     

       418
       418
       -
         

     

       419
       419
       -
         (* Set up headers with API key *)

     

       420
       420
       -
         let headers = Cohttp.Header.init ()

     

       421
       421
       -
           |> fun h -> Cohttp.Header.add h "Authorization" ("Bearer " ^ api_key) in

     

       422
       422
       -
         

     

       423
       423
       -
         Client.get ~headers (Uri.of_string url) >>= fun (resp, body) ->

     

       424
       424
       -
         if resp.status = `OK then

     

       425
       425
       -
           Cohttp_lwt.Body.to_string body

     

       426
       426
       -
         else

     

       427
       427
       -
           let status_code = Cohttp.Code.code_of_status resp.status in

     

       428
       428
       -
           consume_body body >>= fun () ->

     

       429
       429
       -
           Lwt.fail_with (Fmt.str "Asset fetch error: %d" status_code)

     

       430
       430
       -
       

     

       431
       431
       -
       (** Create a new bookmark in Karakeep with optional tags *)

     

       432
       432
       -
       let create_bookmark ~api_key ~url ?title ?note ?tags ?(favourited=false) ?(archived=false) base_url =

     

       433
       433
       -
         let open Cohttp_lwt_unix in

     

       434
       434
       -
         

     

       435
       435
       -
         (* Prepare the bookmark request body *)

     

       436
       436
       -
         let body_obj = [

     

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

     

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

     

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

     

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

     

       441
       441
       -
         ] in

     

       442
       442
       -
         

     

       443
       443
       -
         (* Add optional fields *)

     

       444
       444
       -
         let body_obj = match title with

     

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

     

       446
       446
       -
           | None -> body_obj

     

       447
       447
       -
         in

     

       448
       448
       -
         

     

       449
       449
       -
         let body_obj = match note with

     

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

     

       451
       451
       -
           | None -> body_obj

     

       452
       452
       -
         in

     

       453
       453
       -
         

     

       454
       454
       -
         (* Convert to JSON *)

     

       455
       455
       -
         let body_json = `O body_obj in

     

       456
       456
       -
         let body_str = J.to_string body_json in

     

       457
       457
       -
         

     

       458
       458
       -
         (* Set up headers with API key *)

     

       459
       459
       -
         let headers = Cohttp.Header.init ()

     

       460
       460
       -
           |> fun h -> Cohttp.Header.add h "Authorization" ("Bearer " ^ api_key)

     

       461
       461
       -
           |> fun h -> Cohttp.Header.add h "Content-Type" "application/json"

     

       462
       462
       -
         in

     

       463
       463
       -
         

     

       464
       464
       -
         (* Helper function to ensure we consume all response body data *)

     

       465
       465
       -
         let consume_body body =

     

       466
       466
       -
           Cohttp_lwt.Body.to_string body >>= fun _ ->

     

       467
       467
       -
           Lwt.return_unit

     

       468
       468
       -
         in

     

       469
       469
       -
         

     

       470
       470
       -
         (* Create the bookmark *)

     

       471
       471
       -
         let url_endpoint = Fmt.str "%s/api/v1/bookmarks" base_url in

     

       472
       472
       -
         Client.post ~headers ~body:(Cohttp_lwt.Body.of_string body_str) (Uri.of_string url_endpoint) >>= fun (resp, body) ->

     

       473
       473
       -
         

     

       474
       474
       -
         if resp.status = `Created || resp.status = `OK then

     

       475
       475
       -
           Cohttp_lwt.Body.to_string body >>= fun body_str ->

     

       476
       476
       -
           let json = J.from_string body_str in

     

       477
       477
       -
           let bookmark = parse_bookmark json in

     

       478
       478
       -
           

     

       479
       479
       -
           (* If tags are provided, add them to the bookmark *)

     

       480
       480
       -
           (match tags with

     

       481
       481
       -
            | Some tag_list when tag_list <> [] ->

     

       482
       482
       -
                (* Prepare the tags request body *)

     

       483
       483
       -
                let tag_objects = List.map (fun tag_name -> 

     

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

     

       485
       485
       -
                ) tag_list in

     

       486
       486
       -
                

     

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

     

       488
       488
       -
                let tags_body_str = J.to_string tags_body in

     

       489
       489
       -
                

     

       490
       490
       -
                (* Add tags to the bookmark *)

     

       491
       491
       -
                let tags_url = Fmt.str "%s/api/v1/bookmarks/%s/tags" base_url bookmark.id in

     

       492
       492
       -
                Client.post ~headers ~body:(Cohttp_lwt.Body.of_string tags_body_str) (Uri.of_string tags_url) >>= fun (resp, body) ->

     

       493
       493
       -
                

     

       494
       494
       -
                (* Always consume the response body *)

     

       495
       495
       -
                consume_body body >>= fun () ->

     

       496
       496
       -
                

     

       497
       497
       -
                if resp.status = `OK then

     

       498
       498
       -
                  (* Fetch the bookmark again to get updated tags *)

     

       499
       499
       -
                  fetch_bookmark_details ~api_key base_url bookmark.id

     

       500
       500
       -
                else

     

       501
       501
       -
                  (* Return the bookmark without tags if tag addition failed *)

     

       502
       502
       -
                  Lwt.return bookmark

     

       503
       503
       -
            | _ -> Lwt.return bookmark)

     

       504
       504
       -
         else

     

       505
       505
       -
           let status_code = Cohttp.Code.code_of_status resp.status in

     

       506
       506
       -
           Cohttp_lwt.Body.to_string body >>= fun error_body ->

     

       507
       507
       -
           Lwt.fail_with (Fmt.str "Failed to create bookmark. HTTP error: %d. Details: %s" status_code error_body)

     

       508
       508
       -
       

     

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

     

       510
       510
       -
       let to_bushel_link ?base_url bookmark =

     

       511
       511
       -
         (* Try to find the best title from multiple possible sources *)

     

       512
       512
       -
         let description = 

     

       513
       513
       -
           match bookmark.title with

     

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

     

       515
       515
       -
           | _ -> 

     

       516
       516
       -
               (* Check if there's a title in the content *)

     

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

     

       518
       518
       -
               match content_title with

     

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

     

       520
       520
       -
               | _ -> bookmark.url

     

       521
       521
       -
         in

     

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

     

       523
       523
       -
         

     

       524
       524
       -
         (* Build selective metadata - only include useful fields *)

     

       525
       525
       -
         let metadata = 

     

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

     

       527
       527
       -
           (* Extract key asset IDs *)

     

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

     

       529
       529
       -
             match asset_type with

     

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

     

       531
       531
       -
             | _ -> None

     

       532
       532
       -
           ) bookmark.assets) @

     

       533
       533
       -
           (* Extract only the favicon from content *)

     

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

     

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

     

       536
       536
       -
           ) bookmark.content)

     

       537
       537
       -
         in

     

       538
       538
       -
         

     

       539
       539
       -
         (* Create karakeep data if base_url is provided *)

     

       540
       540
       -
         let karakeep = 

     

       541
       541
       -
           match base_url with

     

       542
       542
       -
           | Some url -> 

     

       543
       543
       -
               Some { 

     

       544
       544
       -
                 Bushel.Link.remote_url = url; 

     

       545
       545
       -
                 id = bookmark.id;

     

       546
       546
       -
                 tags = bookmark.tags;

     

       547
       547
       -
                 metadata = metadata;

     

       548
       548
       -
               }

     

       549
       549
       -
           | None -> None

     

       550
       550
       -
         in

     

       551
       551
       -
         

     

       552
       552
       -
         (* Extract bushel slugs from tags *)

     

       553
       553
       -
         let bushel_slugs = 

     

       554
       554
       -
           List.filter_map (fun tag ->

     

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

     

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

     

       557
       557
       -
             else

     

       558
       558
       -
               None

     

       559
       559
       -
           ) bookmark.tags

     

       560
       560
       -
         in

     

       561
       561
       -
         

     

       562
       562
       -
         (* Create bushel data if we have bushel-related information *)

     

       563
       563
       -
         let bushel = 

     

       564
       564
       -
           if bushel_slugs = [] then None

     

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

     

       566
       566
       -
         in

     

       567
       567
       -
         

     

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

+44 -24

stack/bushel/karakeep/karakeep.mli stack/karakeepe/karakeepe.mli

···

       1
       1
       -
       (** Karakeep API client interface *)

     

       1
       1
       +
       (** Karakeepe API client interface (Eio version) *)

     

       2
       2
        
       

     

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

     

       4
       4
        
       type bookmark = {

     
···

       31
       31
        
       val parse_bookmark_response : Ezjsonm.value -> bookmark_response

     

       32
       32
        
       

     

       33
       33
        
       (** Fetch bookmarks from a Karakeep instance with pagination support

     

       34
       34
       +
           @param sw Eio switch for resource management

     

       35
       35
       +
           @param env Eio environment (provides clock and network)

     

       34
       36
        
           @param api_key API key for authentication

     

       35
       37
        
           @param limit Number of bookmarks to fetch per page (default: 50)

     

       36
       38
        
           @param offset Starting index for pagination (0-based) (default: 0)

     
···

       38
       40
        
           @param include_content Whether to include full content (default: false)

     

       39
       41
        
           @param filter_tags Optional list of tags to filter by

     

       40
       42
        
           @param base_url Base URL of the Karakeep instance

     

       41
       41
       -
           @return A Lwt promise with the bookmark response *)

     

       42
       42
       -
       val fetch_bookmarks : 

     

       43
       43
       -
         api_key:string -> 

     

       44
       44
       -
         ?limit:int -> 

     

       45
       45
       -
         ?offset:int -> 

     

       43
       43
       +
           @return The bookmark response *)

     

       44
       44
       +
       val fetch_bookmarks :

     

       45
       45
       +
         sw:Eio.Switch.t ->

     

       46
       46
       +
         env:< clock: [> float Eio.Time.clock_ty ] Eio.Resource.t; net: [> [> `Generic] Eio.Net.ty ] Eio.Resource.t; .. > ->

     

       47
       47
       +
         api_key:string ->

     

       48
       48
       +
         ?limit:int ->

     

       49
       49
       +
         ?offset:int ->

     

       46
       50
        
         ?cursor:string ->

     

       47
       51
        
         ?include_content:bool ->

     

       48
       52
        
         ?filter_tags:string list ->

     

       49
       49
       -
         string -> 

     

       50
       50
       -
         bookmark_response Lwt.t

     

       53
       53
       +
         string ->

     

       54
       54
       +
         bookmark_response

     

       51
       55
        
       

     

       52
       56
        
       (** Fetch all bookmarks from a Karakeep instance using pagination

     

       57
       57
       +
           @param sw Eio switch for resource management

     

       58
       58
       +
           @param env Eio environment (provides clock and network)

     

       53
       59
        
           @param api_key API key for authentication

     

       54
       60
        
           @param page_size Number of bookmarks to fetch per page (default: 50)

     

       55
       61
        
           @param max_pages Maximum number of pages to fetch (None for all pages)

     

       56
       62
        
           @param filter_tags Optional list of tags to filter by

     

       57
       63
        
           @param include_content Whether to include full content (default: false)

     

       58
       64
        
           @param base_url Base URL of the Karakeep instance

     

       59
       59
       -
           @return A Lwt promise with all bookmarks combined *)

     

       60
       60
       -
       val fetch_all_bookmarks : 

     

       61
       61
       -
         api_key:string -> 

     

       62
       62
       -
         ?page_size:int -> 

     

       63
       63
       -
         ?max_pages:int -> 

     

       65
       65
       +
           @return All bookmarks combined *)

     

       66
       66
       +
       val fetch_all_bookmarks :

     

       67
       67
       +
         sw:Eio.Switch.t ->

     

       68
       68
       +
         env:< clock: [> float Eio.Time.clock_ty ] Eio.Resource.t; net: [> [> `Generic] Eio.Net.ty ] Eio.Resource.t; .. > ->

     

       69
       69
       +
         api_key:string ->

     

       70
       70
       +
         ?page_size:int ->

     

       71
       71
       +
         ?max_pages:int ->

     

       64
       72
        
         ?filter_tags:string list ->

     

       65
       73
        
         ?include_content:bool ->

     

       66
       66
       -
         string -> 

     

       67
       67
       -
         bookmark list Lwt.t

     

       74
       74
       +
         string ->

     

       75
       75
       +
         bookmark list

     

       68
       76
        
       

     

       69
       77
        
       (** Fetch detailed information for a single bookmark by ID

     

       78
       78
       +
           @param sw Eio switch for resource management

     

       79
       79
       +
           @param env Eio environment (provides clock and network)

     

       70
       80
        
           @param api_key API key for authentication

     

       71
       81
        
           @param base_url Base URL of the Karakeep instance

     

       72
       82
        
           @param bookmark_id ID of the bookmark to fetch

     

       73
       73
       -
           @return A Lwt promise with the complete bookmark details *)

     

       74
       74
       -
       val fetch_bookmark_details : 

     

       83
       83
       +
           @return The complete bookmark details *)

     

       84
       84
       +
       val fetch_bookmark_details :

     

       85
       85
       +
         sw:Eio.Switch.t ->

     

       86
       86
       +
         env:< clock: [> float Eio.Time.clock_ty ] Eio.Resource.t; net: [> [> `Generic] Eio.Net.ty ] Eio.Resource.t; .. > ->

     

       75
       87
        
         api_key:string ->

     

       76
       76
       -
         string -> 

     

       77
       77
       -
         string -> 

     

       78
       78
       -
         bookmark Lwt.t

     

       88
       88
       +
         string ->

     

       89
       89
       +
         string ->

     

       90
       90
       +
         bookmark

     

       79
       91
        
       

     

       80
       92
        
       (** Convert a Karakeep bookmark to Bushel.Link.t compatible structure

     

       81
       93
        
           @param base_url Optional base URL of the Karakeep instance (for karakeep_id) *)

     

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

     

       83
       95
        
       

     

       84
       96
        
       (** Fetch an asset from the Karakeep server as a binary string

     

       97
       97
       +
           @param sw Eio switch for resource management

     

       98
       98
       +
           @param env Eio environment (provides clock and network)

     

       85
       99
        
           @param api_key API key for authentication

     

       86
       100
        
           @param base_url Base URL of the Karakeep instance

     

       87
       101
        
           @param asset_id ID of the asset to fetch

     

       88
       88
       -
           @return A Lwt promise with the binary asset data *)

     

       102
       102
       +
           @return The binary asset data *)

     

       89
       103
        
       val fetch_asset :

     

       104
       104
       +
         sw:Eio.Switch.t ->

     

       105
       105
       +
         env:< clock: [> float Eio.Time.clock_ty ] Eio.Resource.t; net: [> [> `Generic] Eio.Net.ty ] Eio.Resource.t; .. > ->

     

       90
       106
        
         api_key:string ->

     

       91
       107
        
         string ->

     

       92
       108
        
         string ->

     

       93
       93
       -
         string Lwt.t

     

       109
       109
       +
         string

     

       94
       110
        
       

     

       95
       111
        
       (** Get the asset URL for a given asset ID

     

       96
       112
        
           @param base_url Base URL of the Karakeep instance

     
···

       102
       118
        
         string

     

       103
       119
        
       

     

       104
       120
        
       (** Create a new bookmark in Karakeep with optional tags

     

       121
       121
       +
           @param sw Eio switch for resource management

     

       122
       122
       +
           @param env Eio environment (provides clock and network)

     

       105
       123
        
           @param api_key API key for authentication

     

       106
       124
        
           @param url The URL to bookmark

     

       107
       125
        
           @param title Optional title for the bookmark

     
···

       110
       128
        
           @param favourited Whether the bookmark should be marked as favourite (default: false)

     

       111
       129
        
           @param archived Whether the bookmark should be archived (default: false)

     

       112
       130
        
           @param base_url Base URL of the Karakeep instance

     

       113
       113
       -
           @return A Lwt promise with the created bookmark *)

     

       131
       131
       +
           @return The created bookmark *)

     

       114
       132
        
       val create_bookmark :

     

       133
       133
       +
         sw:Eio.Switch.t ->

     

       134
       134
       +
         env:< clock: [> float Eio.Time.clock_ty ] Eio.Resource.t; net: [> [> `Generic] Eio.Net.ty ] Eio.Resource.t; .. > ->

     

       115
       135
        
         api_key:string ->

     

       116
       136
        
         url:string ->

     

       117
       137
        
         ?title:string ->

     
···

       120
       140
        
         ?favourited:bool ->

     

       121
       141
        
         ?archived:bool ->

     

       122
       142
        
         string ->

     

       123
       123
       -
         bookmark Lwt.t

     

       143
       143
       +
         bookmark

+4 -3

stack/bushel/lib/dune

···

       10
       10
        
         ptime

     

       11
       11
        
         yaml.unix

     

       12
       12
        
         jekyll-format

     

       13
       13
       -
         lwt

     

       14
       14
       -
         cohttp-lwt-unix

     

       13
       13
       +
         eio

     

       14
       14
       +
         eio_main

     

       15
       15
       +
         requests

     

       15
       16
        
         fmt

     

       16
       17
        
         re

     

       17
       18
        
         ptime.clock

     

       18
       19
        
         ptime.clock.os

     

       19
       19
       -
         typesense-client))

     

       20
       20
       +
         typesense-cliente))

+100 -99

stack/bushel/lib/typesense.ml

···

       1
       1
       -
       open Lwt.Syntax

     

       2
       2
       -
       open Cohttp_lwt_unix

     

       3
       3
       -
       

     

       4
       1
        
       (** TODO:claude Typesense API client for Bushel *)

     

       5
       2
        
       

     

       6
       3
        
       type config = {

     
···

       9
       6
        
         openai_key : string;

     

       10
       7
        
       }

     

       11
       8
        
       

     

       12
       12
       -
       type error = 

     

       9
       9
       +
       type error =

     

       13
       10
        
         | Http_error of int * string

     

       14
       11
        
         | Json_error of string

     

       15
       12
        
         | Connection_error of string

     
···

       21
       18
        
       

     

       22
       19
        
       (** TODO:claude Create authentication headers for Typesense API *)

     

       23
       20
        
       let auth_headers api_key =

     

       24
       24
       -
         Cohttp.Header.of_list [

     

       25
       25
       -
           ("X-TYPESENSE-API-KEY", api_key);

     

       26
       26
       -
           ("Content-Type", "application/json");

     

       27
       27
       -
         ]

     

       21
       21
       +
         Requests.Headers.empty

     

       22
       22
       +
         |> Requests.Headers.set "X-TYPESENSE-API-KEY" api_key

     

       23
       23
       +
         |> Requests.Headers.set "Content-Type" "application/json"

     

       28
       24
        
       

     

       29
       25
        
       (** TODO:claude Make HTTP request to Typesense API *)

     

       30
       30
       -
       let make_request ?(meth=`GET) ?(body="") config path =

     

       26
       26
       +
       let make_request ~sw ~env ?(meth=`GET) ?(body="") config path =

     

       31
       27
        
         let uri = Uri.of_string (config.endpoint ^ path) in

     

       32
       28
        
         let headers = auth_headers config.api_key in

     

       33
       33
       -
         let body = if body = "" then `Empty else `String body in

     

       34
       34
       -
         Lwt.catch (fun () ->

     

       35
       35
       -
           let* resp, body = Client.call ~headers ~body meth uri in

     

       36
       36
       -
           let status = Cohttp.Code.code_of_status (Response.status resp) in

     

       37
       37
       -
           let* body_str = Cohttp_lwt.Body.to_string body in

     

       29
       29
       +
         let body = if body = "" then None else Some (Requests.Body.of_string Requests.Mime.json body) in

     

       30
       30
       +
       

     

       31
       31
       +
         try

     

       32
       32
       +
           let response = Requests.One.request ~sw

     

       33
       33
       +
             ~clock:env#clock ~net:env#net

     

       34
       34
       +
             ?body

     

       35
       35
       +
             ~headers

     

       36
       36
       +
             ~method_:meth

     

       37
       37
       +
             (Uri.to_string uri)

     

       38
       38
       +
           in

     

       39
       39
       +
       

     

       40
       40
       +
           let status = Requests.Response.status_code response in

     

       41
       41
       +
           let body_flow = Requests.Response.body response in

     

       42
       42
       +
           let body_str = Eio.Flow.read_all body_flow in

     

       43
       43
       +
       

     

       38
       44
        
           if status >= 200 && status < 300 then

     

       39
       39
       -
             Lwt.return_ok body_str

     

       45
       45
       +
             Ok body_str

     

       40
       46
        
           else

     

       41
       41
       -
             Lwt.return_error (Http_error (status, body_str))

     

       42
       42
       -
         ) (fun exn ->

     

       43
       43
       -
           Lwt.return_error (Connection_error (Printexc.to_string exn))

     

       44
       44
       -
         )

     

       47
       47
       +
             Error (Http_error (status, body_str))

     

       48
       48
       +
         with exn ->

     

       49
       49
       +
           Error (Connection_error (Printexc.to_string exn))

     

       45
       50
        
       

     

       46
       51
        
       (** TODO:claude Create a collection with given schema *)

     

       47
       47
       -
       let create_collection config (schema : Ezjsonm.value) =

     

       52
       52
       +
       let create_collection ~sw ~env config (schema : Ezjsonm.value) =

     

       48
       53
        
         let body = Ezjsonm.value_to_string schema in

     

       49
       49
       -
         make_request ~meth:`POST ~body config "/collections"

     

       54
       54
       +
         make_request ~sw ~env ~meth:`POST ~body config "/collections"

     

       50
       55
        
       

     

       51
       56
        
       (** TODO:claude Check if collection exists *)

     

       52
       52
       -
       let collection_exists config name =

     

       53
       53
       -
         let* result = make_request config ("/collections/" ^ name) in

     

       57
       57
       +
       let collection_exists ~sw ~env config name =

     

       58
       58
       +
         let result = make_request ~sw ~env config ("/collections/" ^ name) in

     

       54
       59
        
         match result with

     

       55
       55
       -
         | Ok _ -> Lwt.return true

     

       56
       56
       -
         | Error (Http_error (404, _)) -> Lwt.return false

     

       57
       57
       -
         | Error _ -> Lwt.return false

     

       60
       60
       +
         | Ok _ -> true

     

       61
       61
       +
         | Error (Http_error (404, _)) -> false

     

       62
       62
       +
         | Error _ -> false

     

       58
       63
        
       

     

       59
       64
        
       (** TODO:claude Delete a collection *)

     

       60
       60
       -
       let delete_collection config name =

     

       61
       61
       -
         make_request ~meth:`DELETE config ("/collections/" ^ name)

     

       65
       65
       +
       let delete_collection ~sw ~env config name =

     

       66
       66
       +
         make_request ~sw ~env ~meth:`DELETE config ("/collections/" ^ name)

     

       62
       67
        
       

     

       63
       68
        
       (** TODO:claude Upload documents to a collection in batch *)

     

       64
       64
       -
       let upload_documents config collection_name (documents : Ezjsonm.value list) =

     

       69
       69
       +
       let upload_documents ~sw ~env config collection_name (documents : Ezjsonm.value list) =

     

       65
       70
        
         let jsonl_lines = List.map (fun doc -> Ezjsonm.value_to_string doc) documents in

     

       66
       71
        
         let body = String.concat "\n" jsonl_lines in

     

       67
       67
       -
         make_request ~meth:`POST ~body config 

     

       72
       72
       +
         make_request ~sw ~env ~meth:`POST ~body config

     

       68
       73
        
           (Printf.sprintf "/collections/%s/documents/import?action=upsert" collection_name)

     

       69
       74
        
       

     

       70
       75
        
       

     
···

       340
       345
        
         dict updated_schema

     

       341
       346
        
       

     

       342
       347
        
       (** TODO:claude Upload all bushel objects to their respective collections *)

     

       343
       343
       -
       let upload_all config entries =

     

       344
       344
       -
         let* () = Lwt_io.write Lwt_io.stdout "Uploading bushel data to Typesense\n" in

     

       348
       348
       +
       let upload_all ~sw ~env config entries =

     

       349
       349
       +
         print_string "Uploading bushel data to Typesense\n";

     

       345
       350
        
       

     

       346
       351
        
         let contacts = Entry.contacts entries in

     

       347
       352
        
         let papers = Entry.papers entries in

     
···

       360
       365
        
         ] in

     

       361
       366
        
       

     

       362
       367
        
         let upload_collection ((name, schema, documents) : string * Ezjsonm.value * Ezjsonm.value list) =

     

       363
       363
       -
           let* () = Lwt_io.write Lwt_io.stdout (Fmt.str "Processing collection: %s\n" name) in

     

       364
       364
       -
           let* exists = collection_exists config name in

     

       365
       365
       -
           let* () = 

     

       366
       366
       -
             if exists then (

     

       367
       367
       -
               let* () = Lwt_io.write Lwt_io.stdout (Fmt.str "Collection %s exists, deleting...\n" name) in

     

       368
       368
       -
               let* result = delete_collection config name in

     

       369
       369
       -
               match result with

     

       370
       370
       -
               | Ok _ -> Lwt_io.write Lwt_io.stdout (Fmt.str "Deleted collection %s\n" name)

     

       371
       371
       -
               | Error err -> 

     

       372
       372
       -
                 let err_str = Fmt.str "%a" pp_error err in

     

       373
       373
       -
                 Lwt_io.write Lwt_io.stdout (Fmt.str "Failed to delete collection %s: %s\n" name err_str)

     

       374
       374
       -
             ) else

     

       375
       375
       -
               Lwt.return_unit

     

       376
       376
       -
           in

     

       377
       377
       -
           let* () = Lwt_io.write Lwt_io.stdout (Fmt.str "Creating collection %s with %d documents\n" name (List.length documents)) in

     

       378
       378
       -
           let* result = create_collection config schema in

     

       368
       368
       +
           Printf.printf "Processing collection: %s\n%!" name;

     

       369
       369
       +
           let exists = collection_exists ~sw ~env config name in

     

       370
       370
       +
           (if exists then (

     

       371
       371
       +
             Printf.printf "Collection %s exists, deleting...\n%!" name;

     

       372
       372
       +
             let result = delete_collection ~sw ~env config name in

     

       373
       373
       +
             match result with

     

       374
       374
       +
             | Ok _ -> Printf.printf "Deleted collection %s\n%!" name

     

       375
       375
       +
             | Error err ->

     

       376
       376
       +
               let err_str = Fmt.str "%a" pp_error err in

     

       377
       377
       +
               Printf.printf "Failed to delete collection %s: %s\n%!" name err_str

     

       378
       378
       +
           ));

     

       379
       379
       +
           Printf.printf "Creating collection %s with %d documents\n%!" name (List.length documents);

     

       380
       380
       +
           let result = create_collection ~sw ~env config schema in

     

       379
       381
        
           match result with

     

       380
       382
        
           | Ok _ ->

     

       381
       381
       -
             let* () = Lwt_io.write Lwt_io.stdout (Fmt.str "Created collection %s\n" name) in

     

       383
       383
       +
             Printf.printf "Created collection %s\n%!" name;

     

       382
       384
        
             if documents = [] then

     

       383
       383
       -
               Lwt_io.write Lwt_io.stdout (Fmt.str "No documents to upload for %s\n" name)

     

       385
       385
       +
               Printf.printf "No documents to upload for %s\n%!" name

     

       384
       386
        
             else (

     

       385
       385
       -
               let* result = upload_documents config name documents in

     

       387
       387
       +
               let result = upload_documents ~sw ~env config name documents in

     

       386
       388
        
               match result with

     

       387
       387
       -
               | Ok response -> 

     

       389
       389
       +
               | Ok response ->

     

       388
       390
        
                 (* Count successes and failures *)

     

       389
       391
        
                 let lines = String.split_on_char '\n' response in

     

       390
       390
       -
                 let successes = List.fold_left (fun acc line -> 

     

       392
       392
       +
                 let successes = List.fold_left (fun acc line ->

     

       391
       393
        
                   if String.contains line ':' && Str.string_match (Str.regexp ".*success.*true.*") line 0 then acc + 1 else acc) 0 lines in

     

       392
       392
       -
                 let failures = List.fold_left (fun acc line -> 

     

       394
       394
       +
                 let failures = List.fold_left (fun acc line ->

     

       393
       395
        
                   if String.contains line ':' && Str.string_match (Str.regexp ".*success.*false.*") line 0 then acc + 1 else acc) 0 lines in

     

       394
       394
       -
                 let* () = Lwt_io.write Lwt_io.stdout (Fmt.str "Upload results for %s: %d successful, %d failed out of %d total\n" 

     

       395
       395
       -
                   name successes failures (List.length documents)) in

     

       396
       396
       -
                 if failures > 0 then

     

       397
       397
       -
                   let* () = Lwt_io.write Lwt_io.stdout (Fmt.str "Failed documents in %s:\n" name) in

     

       396
       396
       +
                 Printf.printf "Upload results for %s: %d successful, %d failed out of %d total\n%!"

     

       397
       397
       +
                   name successes failures (List.length documents);

     

       398
       398
       +
                 if failures > 0 then (

     

       399
       399
       +
                   Printf.printf "Failed documents in %s:\n%!" name;

     

       398
       400
        
                   let failed_lines = List.filter (fun line -> Str.string_match (Str.regexp ".*success.*false.*") line 0) lines in

     

       399
       399
       -
                   Lwt_list.iter_s (fun line -> Lwt_io.write Lwt_io.stdout (line ^ "\n")) failed_lines

     

       400
       400
       -
                 else

     

       401
       401
       -
                   Lwt.return_unit

     

       402
       402
       -
               | Error err -> 

     

       401
       401
       +
                   List.iter (fun line -> Printf.printf "%s\n%!" line) failed_lines

     

       402
       402
       +
                 )

     

       403
       403
       +
               | Error err ->

     

       403
       404
        
                 let err_str = Fmt.str "%a" pp_error err in

     

       404
       404
       -
                 Lwt_io.write Lwt_io.stdout (Fmt.str "Failed to upload documents to %s: %s\n" name err_str)

     

       405
       405
       +
                 Printf.printf "Failed to upload documents to %s: %s\n%!" name err_str

     

       405
       406
        
             )

     

       406
       407
        
           | Error err ->

     

       407
       408
        
             let err_str = Fmt.str "%a" pp_error err in

     

       408
       408
       -
             Lwt_io.write Lwt_io.stdout (Fmt.str "Failed to create collection %s: %s\n" name err_str)

     

       409
       409
       +
             Printf.printf "Failed to create collection %s: %s\n%!" name err_str

     

       409
       410
        
         in

     

       410
       411
        
       

     

       411
       411
       -
         Lwt_list.iter_s upload_collection collections

     

       412
       412
       +
         List.iter upload_collection collections

     

       412
       413
        
       

     

       413
       413
       -
       (** TODO:claude Re-export search types from Typesense_client *)

     

       414
       414
       -
       type search_result = Typesense_client.search_result = {

     

       414
       414
       +
       (** TODO:claude Re-export search types from Typesense_cliente *)

     

       415
       415
       +
       type search_result = Typesense_cliente.search_result = {

     

       415
       416
        
         id: string;

     

       416
       417
        
         title: string;

     

       417
       418
        
         content: string;

     
···

       421
       422
        
         document: Ezjsonm.value;

     

       422
       423
        
       }

     

       423
       424
        
       

     

       424
       424
       -
       type search_response = Typesense_client.search_response = {

     

       425
       425
       +
       type search_response = Typesense_cliente.search_response = {

     

       425
       426
        
         hits: search_result list;

     

       426
       427
        
         total: int;

     

       427
       428
        
         query_time: float;

     
···

       429
       430
        
       

     

       430
       431
        
       (** TODO:claude Convert bushel config to client config *)

     

       431
       432
        
       let to_client_config (config : config) =

     

       432
       432
       -
         Typesense_client.{ endpoint = config.endpoint; api_key = config.api_key }

     

       433
       433
       +
         Typesense_cliente.{ endpoint = config.endpoint; api_key = config.api_key }

     

       433
       434
        
       

     

       434
       435
        
       (** TODO:claude Search a single collection *)

     

       435
       435
       -
       let search_collection (config : config) collection_name query ?(limit=10) ?(offset=0) () =

     

       436
       436
       +
       let search_collection ~sw ~env (config : config) collection_name query ?(limit=10) ?(offset=0) () =

     

       436
       437
        
         let client_config = to_client_config config in

     

       437
       437
       -
         let* result = Typesense_client.search_collection client_config collection_name query ~limit ~offset () in

     

       438
       438
       +
         let result = Typesense_cliente.search_collection ~sw ~env client_config collection_name query ~limit ~offset () in

     

       438
       439
        
         match result with

     

       439
       439
       -
         | Ok response -> Lwt.return_ok response

     

       440
       440
       -
         | Error (Typesense_client.Http_error (code, msg)) -> Lwt.return_error (Http_error (code, msg))

     

       441
       441
       -
         | Error (Typesense_client.Json_error msg) -> Lwt.return_error (Json_error msg)

     

       442
       442
       -
         | Error (Typesense_client.Connection_error msg) -> Lwt.return_error (Connection_error msg)

     

       440
       440
       +
         | Ok response -> Ok response

     

       441
       441
       +
         | Error (Typesense_cliente.Http_error (code, msg)) -> Error (Http_error (code, msg))

     

       442
       442
       +
         | Error (Typesense_cliente.Json_error msg) -> Error (Json_error msg)

     

       443
       443
       +
         | Error (Typesense_cliente.Connection_error msg) -> Error (Connection_error msg)

     

       443
       444
        
       

     

       444
       445
        
       (** TODO:claude Search across all collections - use client multisearch *)

     

       445
       445
       -
       let search_all (config : config) query ?(limit=10) ?(offset=0) () =

     

       446
       446
       +
       let search_all ~sw ~env (config : config) query ?(limit=10) ?(offset=0) () =

     

       446
       447
        
         let client_config = to_client_config config in

     

       447
       447
       -
         let* result = Typesense_client.multisearch client_config query ~limit:50 () in

     

       448
       448
       +
         let result = Typesense_cliente.multisearch ~sw ~env client_config query ~limit:50 () in

     

       448
       449
        
         match result with

     

       449
       450
        
         | Ok multisearch_resp ->

     

       450
       450
       -
           let combined_response = Typesense_client.combine_multisearch_results multisearch_resp ~limit ~offset () in

     

       451
       451
       -
           Lwt.return_ok combined_response

     

       452
       452
       -
         | Error (Typesense_client.Http_error (code, msg)) -> Lwt.return_error (Http_error (code, msg))

     

       453
       453
       -
         | Error (Typesense_client.Json_error msg) -> Lwt.return_error (Json_error msg)

     

       454
       454
       -
         | Error (Typesense_client.Connection_error msg) -> Lwt.return_error (Connection_error msg)

     

       451
       451
       +
           let combined_response = Typesense_cliente.combine_multisearch_results multisearch_resp ~limit ~offset () in

     

       452
       452
       +
           Ok combined_response

     

       453
       453
       +
         | Error (Typesense_cliente.Http_error (code, msg)) -> Error (Http_error (code, msg))

     

       454
       454
       +
         | Error (Typesense_cliente.Json_error msg) -> Error (Json_error msg)

     

       455
       455
       +
         | Error (Typesense_cliente.Connection_error msg) -> Error (Connection_error msg)

     

       455
       456
        
       

     

       456
       457
        
       (** TODO:claude List all collections *)

     

       457
       457
       -
       let list_collections (config : config) =

     

       458
       458
       +
       let list_collections ~sw ~env (config : config) =

     

       458
       459
        
         let client_config = to_client_config config in

     

       459
       459
       -
         let* result = Typesense_client.list_collections client_config in

     

       460
       460
       +
         let result = Typesense_cliente.list_collections ~sw ~env client_config in

     

       460
       461
        
         match result with

     

       461
       461
       -
         | Ok collections -> Lwt.return_ok collections

     

       462
       462
       -
         | Error (Typesense_client.Http_error (code, msg)) -> Lwt.return_error (Http_error (code, msg))

     

       463
       463
       -
         | Error (Typesense_client.Json_error msg) -> Lwt.return_error (Json_error msg)

     

       464
       464
       -
         | Error (Typesense_client.Connection_error msg) -> Lwt.return_error (Connection_error msg)

     

       462
       462
       +
         | Ok collections -> Ok collections

     

       463
       463
       +
         | Error (Typesense_cliente.Http_error (code, msg)) -> Error (Http_error (code, msg))

     

       464
       464
       +
         | Error (Typesense_cliente.Json_error msg) -> Error (Json_error msg)

     

       465
       465
       +
         | Error (Typesense_cliente.Connection_error msg) -> Error (Connection_error msg)

     

       465
       466
        
       

     

       466
       466
       -
       (** TODO:claude Re-export multisearch types from Typesense_client *)

     

       467
       467
       -
       type multisearch_response = Typesense_client.multisearch_response = {

     

       467
       467
       +
       (** TODO:claude Re-export multisearch types from Typesense_cliente *)

     

       468
       468
       +
       type multisearch_response = Typesense_cliente.multisearch_response = {

     

       468
       469
        
         results: search_response list;

     

       469
       470
        
       }

     

       470
       471
        
       

     

       471
       472
        
       (** TODO:claude Perform multisearch across all collections *)

     

       472
       472
       -
       let multisearch (config : config) query ?(limit=10) () =

     

       473
       473
       +
       let multisearch ~sw ~env (config : config) query ?(limit=10) () =

     

       473
       474
        
         let client_config = to_client_config config in

     

       474
       474
       -
         let* result = Typesense_client.multisearch client_config query ~limit () in

     

       475
       475
       +
         let result = Typesense_cliente.multisearch ~sw ~env client_config query ~limit () in

     

       475
       476
        
         match result with

     

       476
       476
       -
         | Ok multisearch_resp -> Lwt.return_ok multisearch_resp

     

       477
       477
       -
         | Error (Typesense_client.Http_error (code, msg)) -> Lwt.return_error (Http_error (code, msg))

     

       478
       478
       -
         | Error (Typesense_client.Json_error msg) -> Lwt.return_error (Json_error msg)

     

       479
       479
       -
         | Error (Typesense_client.Connection_error msg) -> Lwt.return_error (Connection_error msg)

     

       477
       477
       +
         | Ok multisearch_resp -> Ok multisearch_resp

     

       478
       478
       +
         | Error (Typesense_cliente.Http_error (code, msg)) -> Error (Http_error (code, msg))

     

       479
       479
       +
         | Error (Typesense_cliente.Json_error msg) -> Error (Json_error msg)

     

       480
       480
       +
         | Error (Typesense_cliente.Connection_error msg) -> Error (Connection_error msg)

     

       480
       481
        
       

     

       481
       482
        
       (** TODO:claude Combine multisearch results into single result set *)

     

       482
       483
        
       let combine_multisearch_results (multisearch_resp : multisearch_response) ?(limit=10) ?(offset=0) () =

     

       483
       483
       -
         Typesense_client.combine_multisearch_results multisearch_resp ~limit ~offset ()

     

       484
       484
       +
         Typesense_cliente.combine_multisearch_results multisearch_resp ~limit ~offset ()

     

       484
       485
        
       

     

       485
       486
        
       (** TODO:claude Load configuration from files *)

     

       486
       487
        
       let load_config_from_files () =

     
···

       514
       515
        
         

     

       515
       516
        
         { endpoint; api_key; openai_key }

     

       516
       517
        
       

     

       517
       517
       -
       (** TODO:claude Re-export pretty printer from Typesense_client *)

     

       518
       518
       -
       let pp_search_result_oneline = Typesense_client.pp_search_result_oneline

     

       518
       518
       +
       (** TODO:claude Re-export pretty printer from Typesense_cliente *)

     

       519
       519
       +
       let pp_search_result_oneline = Typesense_cliente.pp_search_result_oneline

+73 -17

stack/bushel/lib/typesense.mli

···

       1
       1
        
       (** Typesense API client for Bushel

     

       2
       2
       -
           

     

       2
       2
       +
       

     

       3
       3
        
           This module provides an OCaml client for the Typesense search engine API.

     

       4
       4
        
           It handles collection management and document indexing for all Bushel object

     

       5
       5
        
           types including contacts, papers, projects, news, videos, notes, and ideas.

     

       6
       6
       -
           

     

       6
       6
       +
       

     

       7
       7
        
           Example usage:

     

       8
       8
        
           {[

     

       9
       9
       -
             let config = { endpoint = "https://search.example.com"; api_key = "xyz123" } in

     

       10
       10
       -
             Lwt_main.run (Typesense.upload_all config "/path/to/bushel/data")

     

       9
       9
       +
             let config = { endpoint = "https://search.example.com"; api_key = "xyz123"; openai_key = "sk-..." } in

     

       10
       10
       +
             Eio_main.run (fun env ->

     

       11
       11
       +
               Eio.Switch.run (fun sw ->

     

       12
       12
       +
                 Typesense.upload_all ~sw ~env config entries))

     

       11
       13
        
           ]}

     

       12
       12
       -
           

     

       14
       14
       +
       

     

       13
       15
        
           TODO:claude *)

     

       14
       16
        
       

     

       15
       17
        
       (** Configuration for connecting to a Typesense server *)

     
···

       20
       22
        
       }

     

       21
       23
        
       

     

       22
       24
        
       (** Possible errors that can occur during Typesense operations *)

     

       23
       23
       -
       type error = 

     

       25
       25
       +
       type error =

     

       24
       26
        
         | Http_error of int * string        (** HTTP error with status code and message *)

     

       25
       27
        
         | Json_error of string              (** JSON parsing or encoding error *)

     

       26
       28
        
         | Connection_error of string        (** Network connection error *)

     
···

       28
       30
        
       (** Pretty-printer for error types *)

     

       29
       31
        
       val pp_error : Format.formatter -> error -> unit

     

       30
       32
        
       

     

       31
       31
       -
       (** Create a collection with the given schema. 

     

       33
       33
       +
       (** Create a collection with the given schema.

     

       32
       34
        
           The schema should follow Typesense's collection schema format.

     

       33
       35
        
           TODO:claude *)

     

       34
       34
       -
       val create_collection : config -> Ezjsonm.value -> (string, error) result Lwt.t

     

       36
       36
       +
       val create_collection :

     

       37
       37
       +
         sw:Eio.Switch.t ->

     

       38
       38
       +
         env:< clock: [> float Eio.Time.clock_ty ] Eio.Resource.t; net: [> [> `Generic ] Eio.Net.ty ] Eio.Resource.t; .. > ->

     

       39
       39
       +
         config ->

     

       40
       40
       +
         Ezjsonm.value ->

     

       41
       41
       +
         (string, error) result

     

       35
       42
        
       

     

       36
       36
       -
       (** Check if a collection exists by name. 

     

       43
       43
       +
       (** Check if a collection exists by name.

     

       37
       44
        
           Returns true if the collection exists, false otherwise.

     

       38
       45
        
           TODO:claude *)

     

       39
       39
       -
       val collection_exists : config -> string -> bool Lwt.t

     

       46
       46
       +
       val collection_exists :

     

       47
       47
       +
         sw:Eio.Switch.t ->

     

       48
       48
       +
         env:< clock: [> float Eio.Time.clock_ty ] Eio.Resource.t; net: [> [> `Generic ] Eio.Net.ty ] Eio.Resource.t; .. > ->

     

       49
       49
       +
         config ->

     

       50
       50
       +
         string ->

     

       51
       51
       +
         bool

     

       40
       52
        
       

     

       41
       53
        
       (** Delete a collection by name.

     

       42
       54
        
           TODO:claude *)

     

       43
       43
       -
       val delete_collection : config -> string -> (string, error) result Lwt.t

     

       55
       55
       +
       val delete_collection :

     

       56
       56
       +
         sw:Eio.Switch.t ->

     

       57
       57
       +
         env:< clock: [> float Eio.Time.clock_ty ] Eio.Resource.t; net: [> [> `Generic ] Eio.Net.ty ] Eio.Resource.t; .. > ->

     

       58
       58
       +
         config ->

     

       59
       59
       +
         string ->

     

       60
       60
       +
         (string, error) result

     

       44
       61
        
       

     

       45
       62
        
       (** Upload documents to a collection in batch using JSONL format.

     

       46
       63
        
           More efficient than uploading documents one by one.

     

       47
       64
        
           TODO:claude *)

     

       48
       48
       -
       val upload_documents : config -> string -> Ezjsonm.value list -> (string, error) result Lwt.t

     

       65
       65
       +
       val upload_documents :

     

       66
       66
       +
         sw:Eio.Switch.t ->

     

       67
       67
       +
         env:< clock: [> float Eio.Time.clock_ty ] Eio.Resource.t; net: [> [> `Generic ] Eio.Net.ty ] Eio.Resource.t; .. > ->

     

       68
       68
       +
         config ->

     

       69
       69
       +
         string ->

     

       70
       70
       +
         Ezjsonm.value list ->

     

       71
       71
       +
         (string, error) result

     

       49
       72
        
       

     

       50
       73
        
       (** Upload all bushel objects to Typesense.

     

       51
       74
        
           This function will:

     
···

       54
       77
        
           - Upload all documents in batches

     

       55
       78
        
           - Report progress to stdout

     

       56
       79
        
           TODO:claude *)

     

       57
       57
       -
       val upload_all : config -> Entry.t -> unit Lwt.t

     

       80
       80
       +
       val upload_all :

     

       81
       81
       +
         sw:Eio.Switch.t ->

     

       82
       82
       +
         env:< clock: [> float Eio.Time.clock_ty ] Eio.Resource.t; net: [> [> `Generic ] Eio.Net.ty ] Eio.Resource.t; .. > ->

     

       83
       83
       +
         config ->

     

       84
       84
       +
         Entry.t ->

     

       85
       85
       +
         unit

     

       58
       86
        
       

     

       59
       87
        
       (** Search result structure containing document information and relevance score *)

     

       60
       88
        
       type search_result = {

     
···

       76
       104
        
       

     

       77
       105
        
       (** Search a specific collection.

     

       78
       106
        
           TODO:claude *)

     

       79
       79
       -
       val search_collection : config -> string -> string -> ?limit:int -> ?offset:int -> unit -> (search_response, error) result Lwt.t

     

       107
       107
       +
       val search_collection :

     

       108
       108
       +
         sw:Eio.Switch.t ->

     

       109
       109
       +
         env:< clock: [> float Eio.Time.clock_ty ] Eio.Resource.t; net: [> [> `Generic ] Eio.Net.ty ] Eio.Resource.t; .. > ->

     

       110
       110
       +
         config ->

     

       111
       111
       +
         string ->

     

       112
       112
       +
         string ->

     

       113
       113
       +
         ?limit:int ->

     

       114
       114
       +
         ?offset:int ->

     

       115
       115
       +
         unit ->

     

       116
       116
       +
         (search_response, error) result

     

       80
       117
        
       

     

       81
       118
        
       (** Search across all bushel collections.

     

       82
       119
        
           Results are sorted by relevance score and paginated.

     

       83
       120
        
           TODO:claude *)

     

       84
       84
       -
       val search_all : config -> string -> ?limit:int -> ?offset:int -> unit -> (search_response, error) result Lwt.t

     

       121
       121
       +
       val search_all :

     

       122
       122
       +
         sw:Eio.Switch.t ->

     

       123
       123
       +
         env:< clock: [> float Eio.Time.clock_ty ] Eio.Resource.t; net: [> [> `Generic ] Eio.Net.ty ] Eio.Resource.t; .. > ->

     

       124
       124
       +
         config ->

     

       125
       125
       +
         string ->

     

       126
       126
       +
         ?limit:int ->

     

       127
       127
       +
         ?offset:int ->

     

       128
       128
       +
         unit ->

     

       129
       129
       +
         (search_response, error) result

     

       85
       130
        
       

     

       86
       131
        
       (** Multisearch response containing results from multiple collections *)

     

       87
       132
        
       type multisearch_response = {

     
···

       91
       136
        
       (** Perform multisearch across all collections using Typesense's multi_search endpoint.

     

       92
       137
        
           More efficient than individual searches as it's done in a single request.

     

       93
       138
        
           TODO:claude *)

     

       94
       94
       -
       val multisearch : config -> string -> ?limit:int -> unit -> (multisearch_response, error) result Lwt.t

     

       139
       139
       +
       val multisearch :

     

       140
       140
       +
         sw:Eio.Switch.t ->

     

       141
       141
       +
         env:< clock: [> float Eio.Time.clock_ty ] Eio.Resource.t; net: [> [> `Generic ] Eio.Net.ty ] Eio.Resource.t; .. > ->

     

       142
       142
       +
         config ->

     

       143
       143
       +
         string ->

     

       144
       144
       +
         ?limit:int ->

     

       145
       145
       +
         unit ->

     

       146
       146
       +
         (multisearch_response, error) result

     

       95
       147
        
       

     

       96
       148
        
       (** Combine multisearch results into a single result set.

     

       97
       149
        
           Results are sorted by relevance score and paginated.

     
···

       101
       153
        
       (** List all collections with document counts.

     

       102
       154
        
           Returns a list of (collection_name, document_count) pairs.

     

       103
       155
        
           TODO:claude *)

     

       104
       104
       -
       val list_collections : config -> ((string * int) list, error) result Lwt.t

     

       156
       156
       +
       val list_collections :

     

       157
       157
       +
         sw:Eio.Switch.t ->

     

       158
       158
       +
         env:< clock: [> float Eio.Time.clock_ty ] Eio.Resource.t; net: [> [> `Generic ] Eio.Net.ty ] Eio.Resource.t; .. > ->

     

       159
       159
       +
         config ->

     

       160
       160
       +
         ((string * int) list, error) result

     

       105
       161
        
       

     

       106
       162
        
       (** Load configuration from .typesense-url and .typesense-api files.

     

       107
       163
        
           Falls back to environment variables and defaults.

-34

stack/bushel/peertube.opam

···

       1
       1
       -
       # This file is generated by dune, edit dune-project instead

     

       2
       2
       -
       opam-version: "2.0"

     

       3
       3
       -
       synopsis: "PeerTube API client"

     

       4
       4
       -
       description: "Client for interacting with PeerTube instances"

     

       5
       5
       -
       maintainer: ["anil@recoil.org"]

     

       6
       6
       -
       authors: ["Anil Madhavapeddy"]

     

       7
       7
       -
       license: "ISC"

     

       8
       8
       -
       homepage: "https://github.com/avsm/bushel"

     

       9
       9
       -
       bug-reports: "https://github.com/avsm/bushel/issues"

     

       10
       10
       -
       depends: [

     

       11
       11
       -
         "dune" {>= "3.17"}

     

       12
       12
       -
         "ocaml" {>= "5.2.0"}

     

       13
       13
       -
         "ezjsonm"

     

       14
       14
       -
         "lwt"

     

       15
       15
       -
         "cohttp-lwt-unix"

     

       16
       16
       -
         "ptime"

     

       17
       17
       -
         "fmt"

     

       18
       18
       -
         "odoc" {with-doc}

     

       19
       19
       -
       ]

     

       20
       20
       -
       build: [

     

       21
       21
       -
         ["dune" "subst"] {dev}

     

       22
       22
       -
         [

     

       23
       23
       -
           "dune"

     

       24
       24
       -
           "build"

     

       25
       25
       -
           "-p"

     

       26
       26
       -
           name

     

       27
       27
       -
           "-j"

     

       28
       28
       -
           jobs

     

       29
       29
       -
           "@install"

     

       30
       30
       -
           "@runtest" {with-test}

     

       31
       31
       -
           "@doc" {with-doc}

     

       32
       32
       -
         ]

     

       33
       33
       -
       ]

     

       34
       34
       -
       dev-repo: "git+https://github.com/avsm/bushel.git"

-4

stack/bushel/peertube/dune

···

       1
       1
       -
       (library

     

       2
       2
       -
        (name peertube)

     

       3
       3
       -
        (public_name peertube)

     

       4
       4
       -
        (libraries ezjsonm lwt cohttp-lwt-unix ptime fmt))

+57 -63

stack/bushel/peertube/peertube.ml stack/peertubee/peertubee.ml

···

       1
       1
       -
       (** PeerTube API client implementation

     

       2
       2
       -
           TODO:claude *)

     

       3
       3
       -
       

     

       4
       4
       -
       open Lwt.Infix

     

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

     

       5
       2
        
       

     

       6
       3
        
       module J = Ezjsonm

     

       7
       4
        
       

     
···

       29
       26
        
       let parse_date str =

     

       30
       27
        
         match Ptime.of_rfc3339 str with

     

       31
       28
        
         | Ok (date, _, _) -> date

     

       32
       32
       -
         | Error _ -> 

     

       29
       29
       +
         | Error _ ->

     

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

     

       34
       31
        
             (* Default to epoch time *)

     

       35
       32
        
             let span_opt = Ptime.Span.of_d_ps (0, 0L) in

     
···

       47
       44
        
       

     

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

     

       49
       46
        
       let get_string_list json path =

     

       50
       50
       -
         try 

     

       47
       47
       +
         try

     

       51
       48
        
           let tags_json = J.find json path in

     

       52
       49
        
           J.get_list J.get_string tags_json

     

       53
       50
        
         with _ -> []

     
···

       60
       57
        
         let description = get_string_opt json ["description"] in

     

       61
       58
        
         let url = J.find json ["url"] |> J.get_string in

     

       62
       59
        
         let embed_path = J.find json ["embedPath"] |> J.get_string in

     

       63
       63
       -
         

     

       60
       60
       +
       

     

       64
       61
        
         (* Parse dates *)

     

       65
       65
       -
         let published_at = 

     

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

     

       62
       62
       +
         let published_at =

     

       63
       63
       +
           J.find json ["publishedAt"] |> J.get_string |> parse_date

     

       67
       64
        
         in

     

       68
       68
       -
         

     

       65
       65
       +
       

     

       69
       66
        
         let originally_published_at =

     

       70
       67
        
           match get_string_opt json ["originallyPublishedAt"] with

     

       71
       68
        
           | Some date -> Some (parse_date date)

     

       72
       69
        
           | None -> None

     

       73
       70
        
         in

     

       74
       74
       -
         

     

       71
       71
       +
       

     

       75
       72
        
         let thumbnail_path = get_string_opt json ["thumbnailPath"] in

     

       76
       73
        
         let tags = get_string_list json ["tags"] in

     

       77
       77
       -
         

     

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

     

       79
       79
       -
           published_at; originally_published_at; 

     

       74
       74
       +
       

     

       75
       75
       +
         { id; uuid; name; description; url; embed_path;

     

       76
       76
       +
           published_at; originally_published_at;

     

       80
       77
        
           thumbnail_path; tags }

     

       81
       78
        
       

     

       82
       79
        
       (** Parse a PeerTube video response *)

     
···

       91
       88
        
           @param start Starting index for pagination (0-based)

     

       92
       89
        
           @param base_url Base URL of the PeerTube instance

     

       93
       90
        
           @param channel Channel name to fetch videos from

     

       94
       94
       -
           @return A Lwt promise with the video response

     

       95
       95
       -
           TODO:claude *)

     

       96
       96
       -
       let fetch_channel_videos ?(count=20) ?(start=0) base_url channel =

     

       97
       97
       -
         let open Cohttp_lwt_unix in

     

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

     

       91
       91
       +
           @return The video response *)

     

       92
       92
       +
       let fetch_channel_videos ~sw ~env ?(count=20) ?(start=0) base_url channel =

     

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

     

       99
       94
        
                     base_url channel count start in

     

       100
       100
       -
         Client.get (Uri.of_string url) >>= fun (resp, body) ->

     

       101
       101
       -
         if resp.status = `OK then

     

       102
       102
       -
           Cohttp_lwt.Body.to_string body >>= fun body_str ->

     

       103
       103
       -
           let json = J.from_string body_str in

     

       104
       104
       -
           Lwt.return (parse_video_response json)

     

       95
       95
       +
         let response = Requests.One.get ~sw ~clock:(Eio.Stdenv.clock env) ~net:(Eio.Stdenv.net env) url in

     

       96
       96
       +
         let status_code = Requests.Response.status_code response in

     

       97
       97
       +
         if status_code = 200 then

     

       98
       98
       +
           let s = Requests.Response.body response |> Eio.Flow.read_all in

     

       99
       99
       +
           let json = J.from_string s in

     

       100
       100
       +
           parse_video_response json

     

       105
       101
        
         else

     

       106
       106
       -
           let status_code = Cohttp.Code.code_of_status resp.status in

     

       107
       107
       -
           Lwt.fail_with (Fmt.str "HTTP error: %d" status_code)

     

       102
       102
       +
           failwith (Fmt.str "HTTP error: %d" status_code)

     

       108
       103
        
       

     

       109
       104
        
       (** Fetch all videos from a PeerTube instance channel using pagination

     

       110
       105
        
           @param page_size Number of videos to fetch per page

     

       111
       106
        
           @param max_pages Maximum number of pages to fetch (None for all pages)

     

       112
       107
        
           @param base_url Base URL of the PeerTube instance

     

       113
       108
        
           @param channel Channel name to fetch videos from

     

       114
       114
       -
           @return A Lwt promise with all videos combined

     

       115
       115
       -
           TODO:claude *)

     

       116
       116
       -
       let fetch_all_channel_videos ?(page_size=20) ?max_pages base_url channel =

     

       109
       109
       +
           @return All videos combined *)

     

       110
       110
       +
       let fetch_all_channel_videos ~sw ~env ?(page_size=20) ?max_pages base_url channel =

     

       117
       111
        
         let rec fetch_pages start acc _total_count =

     

       118
       118
       -
           fetch_channel_videos ~count:page_size ~start base_url channel >>= fun response ->

     

       112
       112
       +
           let response = fetch_channel_videos ~sw ~env ~count:page_size ~start base_url channel in

     

       119
       113
        
           let all_videos = acc @ response.data in

     

       120
       120
       -
           

     

       114
       114
       +
       

     

       121
       115
        
           (* Determine if we need to fetch more pages *)

     

       122
       116
        
           let fetched_count = start + List.length response.data in

     

       123
       117
        
           let more_available = fetched_count < response.total in

     
···

       125
       119
        
             | None -> true

     

       126
       120
        
             | Some max -> (start / page_size) + 1 < max

     

       127
       121
        
           in

     

       128
       128
       -
           

     

       122
       122
       +
       

     

       129
       123
        
           if more_available && under_max_pages then

     

       130
       124
        
             fetch_pages fetched_count all_videos response.total

     

       131
       125
        
           else

     

       132
       132
       -
             Lwt.return all_videos

     

       126
       126
       +
             all_videos

     

       133
       127
        
         in

     

       134
       128
        
         fetch_pages 0 [] 0

     

       135
       129
        
       

     

       136
       130
        
       (** Fetch detailed information for a single video by UUID

     

       137
       131
        
           @param base_url Base URL of the PeerTube instance

     

       138
       132
        
           @param uuid UUID of the video to fetch

     

       139
       139
       -
           @return A Lwt promise with the complete video details

     

       140
       140
       -
           TODO:claude *)

     

       141
       141
       -
       let fetch_video_details base_url uuid =

     

       142
       142
       -
         let open Cohttp_lwt_unix in

     

       133
       133
       +
           @return The complete video details *)

     

       134
       134
       +
       let fetch_video_details ~sw ~env base_url uuid =

     

       143
       135
        
         let url = Printf.sprintf "%s/api/v1/videos/%s" base_url uuid in

     

       144
       144
       -
         Client.get (Uri.of_string url) >>= fun (resp, body) ->

     

       145
       145
       -
         if resp.status = `OK then

     

       146
       146
       -
           Cohttp_lwt.Body.to_string body >>= fun body_str ->

     

       147
       147
       -
           let json = J.from_string body_str in

     

       136
       136
       +
         let response = Requests.One.get ~sw ~clock:(Eio.Stdenv.clock env) ~net:(Eio.Stdenv.net env) url in

     

       137
       137
       +
         let status_code = Requests.Response.status_code response in

     

       138
       138
       +
         if status_code = 200 then

     

       139
       139
       +
           let s = Requests.Response.body response |> Eio.Flow.read_all in

     

       140
       140
       +
           let json = J.from_string s in

     

       148
       141
        
           (* Parse the single video details *)

     

       149
       149
       -
           Lwt.return (parse_video json)

     

       142
       142
       +
           parse_video json

     

       150
       143
        
         else

     

       151
       151
       -
           let status_code = Cohttp.Code.code_of_status resp.status in

     

       152
       152
       -
           Lwt.fail_with (Fmt.str "HTTP error: %d" status_code)

     

       144
       144
       +
           failwith (Fmt.str "HTTP error: %d" status_code)

     

       153
       145
        
       

     

       154
       146
        
       (** Convert a PeerTube video to Bushel.Video.t compatible structure *)

     

       155
       147
        
       let to_bushel_video video =

     
···

       167
       159
        
           @param base_url Base URL of the PeerTube instance

     

       168
       160
        
           @param video The video to download the thumbnail for

     

       169
       161
        
           @param output_path Path where to save the thumbnail

     

       170
       170
       -
           @return A Lwt promise with unit on success *)

     

       171
       171
       -
       let download_thumbnail base_url video output_path =

     

       162
       162
       +
           @return Ok () on success or Error with message *)

     

       163
       163
       +
       let download_thumbnail ~sw ~env base_url video output_path =

     

       172
       164
        
         match thumbnail_url base_url video with

     

       173
       165
        
         | None ->

     

       174
       174
       -
             Lwt.return (Error (`Msg (Printf.sprintf "No thumbnail available for video %s" video.uuid)))

     

       166
       166
       +
             Error (`Msg (Printf.sprintf "No thumbnail available for video %s" video.uuid))

     

       175
       167
        
         | Some url ->

     

       176
       176
       -
             let open Cohttp_lwt_unix in

     

       177
       177
       -
             Client.get (Uri.of_string url) >>= fun (resp, body) ->

     

       178
       178
       -
             if resp.status = `OK then

     

       179
       179
       -
               Cohttp_lwt.Body.to_string body >>= fun body_str ->

     

       180
       180
       -
               Lwt.catch

     

       181
       181
       -
                 (fun () ->

     

       182
       182
       -
                   let oc = open_out_bin output_path in

     

       183
       183
       -
                   output_string oc body_str;

     

       184
       184
       -
                   close_out oc;

     

       185
       185
       -
                   Lwt.return (Ok ()))

     

       186
       186
       -
                 (fun exn ->

     

       187
       187
       -
                   Lwt.return (Error (`Msg (Printf.sprintf "Failed to write thumbnail: %s"

     

       188
       188
       -
                     (Printexc.to_string exn)))))

     

       189
       189
       -
             else

     

       190
       190
       -
               let status_code = Cohttp.Code.code_of_status resp.status in

     

       191
       191
       -
               Lwt.return (Error (`Msg (Printf.sprintf "HTTP error downloading thumbnail: %d" status_code)))
     

       168
       168
       +
             try

     

       169
       169
       +
               let response = Requests.One.get ~sw ~clock:(Eio.Stdenv.clock env) ~net:(Eio.Stdenv.net env) url in

     

       170
       170
       +
               let status_code = Requests.Response.status_code response in

     

       171
       171
       +
               if status_code = 200 then

     

       172
       172
       +
                 let body_str = Requests.Response.body response |> Eio.Flow.read_all in

     

       173
       173
       +
                 try

     

       174
       174
       +
                   let fs = Eio.Stdenv.fs env in

     

       175
       175
       +
                   let output_eio_path = Eio.Path.(fs / output_path) in

     

       176
       176
       +
                   Eio.Path.save ~create:(`Or_truncate 0o644) output_eio_path body_str;

     

       177
       177
       +
                   Ok ()

     

       178
       178
       +
                 with exn ->

     

       179
       179
       +
                   Error (`Msg (Printf.sprintf "Failed to write thumbnail: %s"

     

       180
       180
       +
                     (Printexc.to_string exn)))

     

       181
       181
       +
               else

     

       182
       182
       +
                 Error (`Msg (Printf.sprintf "HTTP error downloading thumbnail: %d" status_code))

     

       183
       183
       +
             with exn ->

     

       184
       184
       +
               Error (`Msg (Printf.sprintf "Failed to download thumbnail: %s"

     

       185
       185
       +
                 (Printexc.to_string exn)))

+13 -6

stack/bushel/peertube/peertube.mli stack/peertubee/peertubee.mli

···

       1
       1
       -
       (** PeerTube API client interface

     

       2
       2
       -
           TODO:claude *)

     

       1
       1
       +
       (** PeerTube API client interface (Eio version) *)

     

       3
       2
        
       

     

       4
       3
        
       (** Type representing a PeerTube video *)

     

       5
       4
        
       type video = {

     
···

       28
       27
        
       val parse_video_response : Ezjsonm.value -> video_response

     

       29
       28
        
       

     

       30
       29
        
       (** Fetch videos from a PeerTube instance channel with pagination support

     

       30
       30
       +
           @param sw Eio switch for resource management

     

       31
       31
       +
           @param env Eio environment for network and clock access

     

       31
       32
        
           @param count Number of videos to fetch per page (default: 20)

     

       32
       33
        
           @param start Starting index for pagination (0-based) (default: 0)

     

       33
       34
        
           @param base_url Base URL of the PeerTube instance

     

       34
       35
        
           @param channel Channel name to fetch videos from *)

     

       35
       35
       -
       val fetch_channel_videos : ?count:int -> ?start:int -> string -> string -> video_response Lwt.t

     

       36
       36
       +
       val fetch_channel_videos : sw:Eio.Switch.t -> env:< clock : 'a Eio.Time.clock; net : 'b Eio.Net.t; .. > -> ?count:int -> ?start:int -> string -> string -> video_response

     

       36
       37
        
       

     

       37
       38
        
       (** Fetch all videos from a PeerTube instance channel using pagination

     

       39
       39
       +
           @param sw Eio switch for resource management

     

       40
       40
       +
           @param env Eio environment for network and clock access

     

       38
       41
        
           @param page_size Number of videos to fetch per page (default: 20)

     

       39
       42
        
           @param max_pages Maximum number of pages to fetch (None for all pages)

     

       40
       43
        
           @param base_url Base URL of the PeerTube instance

     

       41
       44
        
           @param channel Channel name to fetch videos from *)

     

       42
       42
       -
       val fetch_all_channel_videos : ?page_size:int -> ?max_pages:int -> string -> string -> video list Lwt.t

     

       45
       45
       +
       val fetch_all_channel_videos : sw:Eio.Switch.t -> env:< clock : 'a Eio.Time.clock; net : 'b Eio.Net.t; .. > -> ?page_size:int -> ?max_pages:int -> string -> string -> video list

     

       43
       46
        
       

     

       44
       47
        
       (** Fetch detailed information for a single video by UUID

     

       48
       48
       +
           @param sw Eio switch for resource management

     

       49
       49
       +
           @param env Eio environment for network and clock access

     

       45
       50
        
           @param base_url Base URL of the PeerTube instance

     

       46
       51
        
           @param uuid UUID of the video to fetch *)

     

       47
       47
       -
       val fetch_video_details : string -> string -> video Lwt.t

     

       52
       52
       +
       val fetch_video_details : sw:Eio.Switch.t -> env:< clock : 'a Eio.Time.clock; net : 'b Eio.Net.t; .. > -> string -> string -> video

     

       48
       53
        
       

     

       49
       54
        
       (** Convert a PeerTube video to Bushel.Video.t compatible structure

     

       50
       55
        
           Returns (description, published_date, title, url, uuid, slug) *)

     
···

       56
       61
        
       val thumbnail_url : string -> video -> string option

     

       57
       62
        
       

     

       58
       63
        
       (** Download a thumbnail to a file

     

       64
       64
       +
           @param sw Eio switch for resource management

     

       65
       65
       +
           @param env Eio environment for network and filesystem access

     

       59
       66
        
           @param base_url Base URL of the PeerTube instance

     

       60
       67
        
           @param video The video to download the thumbnail for

     

       61
       68
        
           @param output_path Path where to save the thumbnail *)

     

       62
       62
       -
       val download_thumbnail : string -> video -> string -> (unit, [> `Msg of string]) result Lwt.t
     

       69
       69
       +
       val download_thumbnail : sw:Eio.Switch.t -> env:< clock : 'a Eio.Time.clock; net : 'b Eio.Net.t; fs : 'c Eio.Path.t; .. > -> string -> video -> string -> (unit, [> `Msg of string]) result

-36

stack/bushel/typesense-client.opam

···

       1
       1
       -
       # This file is generated by dune, edit dune-project instead

     

       2
       2
       -
       opam-version: "2.0"

     

       3
       3
       -
       synopsis: "Standalone Typesense client for OCaml"

     

       4
       4
       -
       description:

     

       5
       5
       -
         "A standalone Typesense client that can be compiled to JavaScript"

     

       6
       6
       -
       maintainer: ["anil@recoil.org"]

     

       7
       7
       -
       authors: ["Anil Madhavapeddy"]

     

       8
       8
       -
       license: "ISC"

     

       9
       9
       -
       homepage: "https://github.com/avsm/bushel"

     

       10
       10
       -
       bug-reports: "https://github.com/avsm/bushel/issues"

     

       11
       11
       -
       depends: [

     

       12
       12
       -
         "dune" {>= "3.17"}

     

       13
       13
       -
         "ocaml" {>= "5.2.0"}

     

       14
       14
       -
         "ezjsonm"

     

       15
       15
       -
         "lwt"

     

       16
       16
       -
         "cohttp-lwt-unix"

     

       17
       17
       -
         "ptime"

     

       18
       18
       -
         "fmt"

     

       19
       19
       -
         "uri"

     

       20
       20
       -
         "odoc" {with-doc}

     

       21
       21
       -
       ]

     

       22
       22
       -
       build: [

     

       23
       23
       -
         ["dune" "subst"] {dev}

     

       24
       24
       -
         [

     

       25
       25
       -
           "dune"

     

       26
       26
       -
           "build"

     

       27
       27
       -
           "-p"

     

       28
       28
       -
           name

     

       29
       29
       -
           "-j"

     

       30
       30
       -
           jobs

     

       31
       31
       -
           "@install"

     

       32
       32
       -
           "@runtest" {with-test}

     

       33
       33
       -
           "@doc" {with-doc}

     

       34
       34
       -
         ]

     

       35
       35
       -
       ]

     

       36
       36
       -
       dev-repo: "git+https://github.com/avsm/bushel.git"

-5

stack/bushel/typesense-client/dune

···

       1
       1
       -
       (library

     

       2
       2
       -
        (public_name typesense-client)

     

       3
       3
       -
        (name typesense_client)

     

       4
       4
       -
        (libraries lwt cohttp-lwt-unix ezjsonm fmt uri ptime)

     

       5
       5
       -
        (preprocess (pps lwt_ppx)))

+89 -87

stack/bushel/typesense-client/typesense_client.ml stack/typesense-cliente/typesense_cliente.ml

···

       1
       1
       -
       open Lwt.Syntax

     

       2
       2
       -
       open Cohttp_lwt_unix

     

       3
       3
       -
       

     

       4
       4
       -
       (** TODO:claude Standalone Typesense client for OCaml *)

     

       1
       1
       +
       (** Typesense client for OCaml using Eio and Requests *)

     

       5
       2
        
       

     

       6
       3
        
       (** Configuration for Typesense client *)

     

       7
       4
        
       type config = {

     
···

       10
       7
        
       }

     

       11
       8
        
       

     

       12
       9
        
       (** Error types for Typesense operations *)

     

       13
       13
       -
       type error = 

     

       10
       10
       +
       type error =

     

       14
       11
        
         | Http_error of int * string

     

       15
       12
        
         | Json_error of string

     

       16
       13
        
         | Connection_error of string

     
···

       20
       17
        
         | Json_error msg -> Fmt.pf fmt "JSON error: %s" msg

     

       21
       18
        
         | Connection_error msg -> Fmt.pf fmt "Connection error: %s" msg

     

       22
       19
        
       

     

       23
       23
       -
       (** TODO:claude Create authentication headers for Typesense API *)

     

       20
       20
       +
       (** Create authentication headers for Typesense API *)

     

       24
       21
        
       let auth_headers api_key =

     

       25
       25
       -
         Cohttp.Header.of_list [

     

       26
       26
       -
           ("X-TYPESENSE-API-KEY", api_key);

     

       27
       27
       -
           ("Content-Type", "application/json");

     

       28
       28
       -
         ]

     

       22
       22
       +
         Requests.Headers.empty

     

       23
       23
       +
         |> Requests.Headers.set "X-TYPESENSE-API-KEY" api_key

     

       24
       24
       +
         |> Requests.Headers.set "Content-Type" "application/json"

     

       29
       25
        
       

     

       30
       30
       -
       (** TODO:claude Make HTTP request to Typesense API *)

     

       31
       31
       -
       let make_request ?(meth=`GET) ?(body="") config path =

     

       26
       26
       +
       (** Make HTTP request to Typesense API *)

     

       27
       27
       +
       let make_request ~sw ~env ?(meth=`GET) ?(body="") config path =

     

       32
       28
        
         let uri = Uri.of_string (config.endpoint ^ path) in

     

       33
       29
        
         let headers = auth_headers config.api_key in

     

       34
       34
       -
         let body = if body = "" then `Empty else `String body in

     

       35
       35
       -
         Lwt.catch (fun () ->

     

       36
       36
       -
           let* resp, body = Client.call ~headers ~body meth uri in

     

       37
       37
       -
           let status = Cohttp.Code.code_of_status (Response.status resp) in

     

       38
       38
       -
           let* body_str = Cohttp_lwt.Body.to_string body in

     

       30
       30
       +
         let body = if body = "" then None else Some (Requests.Body.of_string Requests.Mime.json body) in

     

       31
       31
       +
       

     

       32
       32
       +
         try

     

       33
       33
       +
           let response = Requests.One.request ~sw ~clock:env#clock ~net:env#net

     

       34
       34
       +
             ?body

     

       35
       35
       +
             ~headers

     

       36
       36
       +
             ~method_:meth

     

       37
       37
       +
             (Uri.to_string uri)

     

       38
       38
       +
           in

     

       39
       39
       +
       

     

       40
       40
       +
           let status = Requests.Response.status_code response in

     

       41
       41
       +
           let body_flow = Requests.Response.body response in

     

       42
       42
       +
           let body_str = Eio.Flow.read_all body_flow in

     

       43
       43
       +
       

     

       39
       44
        
           if status >= 200 && status < 300 then

     

       40
       40
       -
             Lwt.return_ok body_str

     

       45
       45
       +
             Ok body_str

     

       41
       46
        
           else

     

       42
       42
       -
             Lwt.return_error (Http_error (status, body_str))

     

       43
       43
       -
         ) (fun exn ->

     

       44
       44
       -
           Lwt.return_error (Connection_error (Printexc.to_string exn))

     

       45
       45
       -
         )

     

       47
       47
       +
             Error (Http_error (status, body_str))

     

       48
       48
       +
         with exn ->

     

       49
       49
       +
           Error (Connection_error (Printexc.to_string exn))

     

       46
       50
        
       

     

       47
       47
       -
       (** TODO:claude Search result types *)

     

       51
       51
       +
       (** Search result types *)

     

       48
       52
        
       type search_result = {

     

       49
       53
        
         id: string;

     

       50
       54
        
         title: string;

     
···

       61
       65
        
         query_time: float;

     

       62
       66
        
       }

     

       63
       67
        
       

     

       64
       64
       -
       (** TODO:claude Parse search result from JSON *)

     

       68
       68
       +
       (** Parse search result from JSON *)

     

       65
       69
        
       let parse_search_result collection json =

     

       66
       70
        
         let open Ezjsonm in

     

       67
       71
        
         let document = get_dict json |> List.assoc "document" in

     

       68
       72
        
         let highlights = try get_dict json |> List.assoc "highlights" with _ -> `A [] in

     

       69
       73
        
         let score = try get_dict json |> List.assoc "text_match" |> get_float with _ -> 0.0 in

     

       70
       70
       -
         

     

       74
       74
       +
       

     

       71
       75
        
         let id = get_dict document |> List.assoc "id" |> get_string in

     

       72
       76
        
         let title = try get_dict document |> List.assoc "title" |> get_string with _ -> "" in

     

       73
       77
        
         let content = try

     
···

       81
       85
        
           | "contacts" -> get_dict document |> List.assoc "name" |> get_string

     

       82
       86
        
           | _ -> ""

     

       83
       87
        
         with _ -> "" in

     

       84
       84
       -
         

     

       88
       88
       +
       

     

       85
       89
        
         let parse_highlights highlights =

     

       86
       90
        
           try

     

       87
       91
        
             get_list (fun h ->

     
···

       91
       95
        
             ) highlights

     

       92
       96
        
           with _ -> []

     

       93
       97
        
         in

     

       94
       94
       -
         

     

       98
       98
       +
       

     

       95
       99
        
         { id; title; content; score; collection; highlights = parse_highlights highlights; document }

     

       96
       100
        
       

     

       97
       97
       -
       (** TODO:claude Parse search response from JSON *)

     

       101
       101
       +
       (** Parse search response from JSON *)

     

       98
       102
        
       let parse_search_response collection json =

     

       99
       103
        
         let open Ezjsonm in

     

       100
       104
        
         let hits = get_dict json |> List.assoc "hits" |> get_list (parse_search_result collection) in

     
···

       102
       106
        
         let query_time = get_dict json |> List.assoc "search_time_ms" |> get_float in

     

       103
       107
        
         { hits; total; query_time }

     

       104
       108
        
       

     

       105
       105
       -
       (** TODO:claude Search a single collection *)

     

       106
       106
       -
       let search_collection config collection_name query ?(limit=10) ?(offset=0) () =

     

       109
       109
       +
       (** Search a single collection *)

     

       110
       110
       +
       let search_collection ~sw ~env config collection_name query ?(limit=10) ?(offset=0) () =

     

       107
       111
        
         let escaped_query = Uri.pct_encode query in

     

       108
       112
        
         let query_fields = match collection_name with

     

       109
       113
        
           | "papers" -> "title,abstract,authors"

     
···

       117
       121
        
         in

     

       118
       122
        
         let path = Printf.sprintf "/collections/%s/documents/search?q=%s&query_by=%s&per_page=%d&page=%d&highlight_full_fields=%s"

     

       119
       123
        
           collection_name escaped_query query_fields limit ((offset / limit) + 1) query_fields in

     

       120
       120
       -
         let* result = make_request config path in

     

       121
       121
       -
         match result with

     

       124
       124
       +
       

     

       125
       125
       +
         match make_request ~sw ~env config path with

     

       122
       126
        
         | Ok response_str ->

     

       123
       127
        
           (try

     

       124
       128
        
             let json = Ezjsonm.from_string response_str in

     

       125
       129
        
             let search_response = parse_search_response collection_name json in

     

       126
       126
       -
             Lwt.return_ok search_response

     

       130
       130
       +
             Ok search_response

     

       127
       131
        
           with exn ->

     

       128
       128
       -
             Lwt.return_error (Json_error (Printexc.to_string exn)))

     

       129
       129
       -
         | Error err -> Lwt.return_error err

     

       132
       132
       +
             Error (Json_error (Printexc.to_string exn)))

     

       133
       133
       +
         | Error err -> Error err

     

       130
       134
        
       

     

       131
       131
       -
       (** TODO:claude Helper function to drop n elements from list *)

     

       135
       135
       +
       (** Helper function to drop n elements from list *)

     

       132
       136
        
       let rec drop n lst =

     

       133
       137
        
         if n <= 0 then lst

     

       134
       138
        
         else match lst with

     

       135
       139
        
         | [] -> []

     

       136
       140
        
         | _ :: tl -> drop (n - 1) tl

     

       137
       141
        
       

     

       138
       138
       -
       (** TODO:claude Helper function to take n elements from list *)

     

       142
       142
       +
       (** Helper function to take n elements from list *)

     

       139
       143
        
       let rec take n lst =

     

       140
       144
        
         if n <= 0 then []

     

       141
       145
        
         else match lst with

     

       142
       146
        
         | [] -> []

     

       143
       147
        
         | hd :: tl -> hd :: take (n - 1) tl

     

       144
       148
        
       

     

       145
       145
       -
       (** TODO:claude Multisearch result types *)

     

       149
       149
       +
       (** Multisearch result types *)

     

       146
       150
        
       type multisearch_response = {

     

       147
       151
        
         results: search_response list;

     

       148
       152
        
       }

     

       149
       153
        
       

     

       150
       150
       -
       (** TODO:claude Parse multisearch response from JSON *)

     

       154
       154
       +
       (** Parse multisearch response from JSON *)

     

       151
       155
        
       let parse_multisearch_response json =

     

       152
       156
        
         let open Ezjsonm in

     

       153
       157
        
         let results_json = get_dict json |> List.assoc "results" |> get_list (fun r -> r) in

     

       154
       158
        
         let results = List.mapi (fun i result_json ->

     

       155
       159
        
           let collection_name = match i with

     

       156
       160
        
             | 0 -> "contacts"

     

       157
       157
       -
             | 1 -> "news" 

     

       161
       161
       +
             | 1 -> "news"

     

       158
       162
        
             | 2 -> "notes"

     

       159
       163
        
             | 3 -> "papers"

     

       160
       164
        
             | 4 -> "projects"

     
···

       166
       170
        
         ) results_json in

     

       167
       171
        
         { results }

     

       168
       172
        
       

     

       169
       169
       -
       (** TODO:claude Perform multisearch across all collections *)

     

       170
       170
       -
       let multisearch config query ?(limit=10) () =

     

       173
       173
       +
       (** Perform multisearch across all collections *)

     

       174
       174
       +
       let multisearch ~sw ~env config query ?(limit=10) () =

     

       171
       175
        
         let collections = ["contacts"; "news"; "notes"; "papers"; "projects"; "ideas"; "videos"] in

     

       172
       176
        
         let query_by_collection = [

     

       173
       177
        
           ("contacts", "name,names,email,handle,github,twitter,url");

     
···

       178
       182
        
           ("ideas", "title,description,level,status,project,supervisors,tags");

     

       179
       183
        
           ("videos", "title,description,channel,platform,tags");

     

       180
       184
        
         ] in

     

       181
       181
       -
         

     

       185
       185
       +
       

     

       182
       186
        
         let searches = List.map (fun collection ->

     

       183
       187
        
           let query_by = List.assoc collection query_by_collection in

     

       184
       188
        
           Ezjsonm.dict [

     
···

       189
       193
        
             ("per_page", Ezjsonm.int limit);

     

       190
       194
        
           ]

     

       191
       195
        
         ) collections in

     

       192
       192
       -
         

     

       196
       196
       +
       

     

       193
       197
        
         let body = Ezjsonm.dict [("searches", Ezjsonm.list (fun x -> x) searches)] |> Ezjsonm.value_to_string in

     

       194
       194
       -
         let* result = make_request ~meth:`POST ~body config "/multi_search" in

     

       195
       195
       -
         

     

       196
       196
       -
         match result with

     

       198
       198
       +
       

     

       199
       199
       +
         match make_request ~sw ~env ~meth:`POST ~body config "/multi_search" with

     

       197
       200
        
         | Ok response_str ->

     

       198
       201
        
           (try

     

       199
       202
        
             let json = Ezjsonm.from_string response_str in

     

       200
       203
        
             let multisearch_resp = parse_multisearch_response json in

     

       201
       201
       -
             Lwt.return_ok multisearch_resp

     

       204
       204
       +
             Ok multisearch_resp

     

       202
       205
        
           with exn ->

     

       203
       203
       -
             Lwt.return_error (Json_error (Printexc.to_string exn)))

     

       204
       204
       -
         | Error err -> Lwt.return_error err

     

       206
       206
       +
             Error (Json_error (Printexc.to_string exn)))

     

       207
       207
       +
         | Error err -> Error err

     

       205
       208
        
       

     

       206
       206
       -
       (** TODO:claude Combine multisearch results into single result set *)

     

       209
       209
       +
       (** Combine multisearch results into single result set *)

     

       207
       210
        
       let combine_multisearch_results (multisearch_resp : multisearch_response) ?(limit=10) ?(offset=0) () =

     

       208
       211
        
         (* Collect all hits from all collections *)

     

       209
       212
        
         let all_hits = List.fold_left (fun acc response ->

     

       210
       213
        
           response.hits @ acc

     

       211
       214
        
         ) [] multisearch_resp.results in

     

       212
       212
       -
         

     

       215
       215
       +
       

     

       213
       216
        
         (* Sort by score descending *)

     

       214
       217
        
         let sorted_hits = List.sort (fun a b -> Float.compare b.score a.score) all_hits in

     

       215
       215
       -
         

     

       218
       218
       +
       

     

       216
       219
        
         (* Apply offset and limit *)

     

       217
       220
        
         let dropped_hits = drop offset sorted_hits in

     

       218
       221
        
         let final_hits = take limit dropped_hits in

     

       219
       219
       -
         

     

       222
       222
       +
       

     

       220
       223
        
         (* Calculate totals *)

     

       221
       224
        
         let total = List.fold_left (fun acc response -> acc + response.total) 0 multisearch_resp.results in

     

       222
       225
        
         let query_time = List.fold_left (fun acc response -> acc +. response.query_time) 0.0 multisearch_resp.results in

     

       223
       223
       -
         

     

       226
       226
       +
       

     

       224
       227
        
         { hits = final_hits; total; query_time }

     

       225
       228
        
       

     

       226
       226
       -
       (** TODO:claude List all collections *)

     

       227
       227
       -
       let list_collections config =

     

       228
       228
       -
         let* result = make_request config "/collections" in

     

       229
       229
       -
         match result with

     

       229
       229
       +
       (** List all collections *)

     

       230
       230
       +
       let list_collections ~sw ~env config =

     

       231
       231
       +
         match make_request ~sw ~env config "/collections" with

     

       230
       232
        
         | Ok response_str ->

     

       231
       233
        
           (try

     

       232
       234
        
             let json = Ezjsonm.from_string response_str in

     
···

       235
       237
        
               let num_docs = Ezjsonm.get_dict c |> List.assoc "num_documents" |> Ezjsonm.get_int in

     

       236
       238
        
               (name, num_docs)

     

       237
       239
        
             ) json in

     

       238
       238
       -
             Lwt.return_ok collections

     

       240
       240
       +
             Ok collections

     

       239
       241
        
           with exn ->

     

       240
       240
       -
             Lwt.return_error (Json_error (Printexc.to_string exn)))

     

       241
       241
       -
         | Error err -> Lwt.return_error err

     

       242
       242
       +
             Error (Json_error (Printexc.to_string exn)))

     

       243
       243
       +
         | Error err -> Error err

     

       242
       244
        
       

     

       243
       243
       -
       (** TODO:claude Pretty printer utilities *)

     

       245
       245
       +
       (** Pretty printer utilities *)

     

       244
       246
        
       

     

       245
       247
        
       (** Extract field value from JSON document or return empty string if not found *)

     

       246
       248
        
       let extract_field_string document field =

     
···

       285
       287
        
         | ts when List.length ts <= 3 -> String.concat ", " ts

     

       286
       288
        
         | ts -> Printf.sprintf "%s (+%d more)" (String.concat ", " (take 2 ts)) (List.length ts - 2)

     

       287
       289
        
       

     

       288
       288
       -
       (** TODO:claude One-line pretty printer for search results *)

     

       290
       290
       +
       (** One-line pretty printer for search results *)

     

       289
       291
        
       let pp_search_result_oneline (result : search_result) =

     

       290
       292
        
         let document = result.document in

     

       291
       291
       -
         

     

       293
       293
       +
       

     

       292
       294
        
         match result.collection with

     

       293
       295
        
         | "papers" ->

     

       294
       296
        
           let authors = extract_field_string_list document "authors" in

     

       295
       297
        
           let date = extract_field_string document "date" in

     

       296
       298
        
           let journal = extract_field_string_list document "journal" in

     

       297
       299
        
           let journal_str = match journal with [] -> "" | j :: _ -> Printf.sprintf " (%s)" j in

     

       298
       298
       -
           Printf.sprintf "📄 %s — %s%s %s" 

     

       299
       299
       -
             result.title 

     

       300
       300
       +
           Printf.sprintf "📄 %s — %s%s %s"

     

       301
       301
       +
             result.title

     

       300
       302
        
             (format_authors authors)

     

       301
       303
        
             journal_str

     

       302
       304
        
             (format_date date)

     

       303
       303
       -
             

     

       305
       305
       +
       

     

       304
       306
        
         | "videos" ->

     

       305
       307
        
           let date = extract_field_string document "published_date" in

     

       306
       308
        
           let uuid = extract_field_string document "uuid" in

     
···

       308
       310
        
           let talk_indicator = if is_talk then "🎤" else "🎬" in

     

       309
       311
        
           let url = extract_field_string document "url" in

     

       310
       312
        
           let url_display = if url = "" then "" else Printf.sprintf " <%s>" url in

     

       311
       311
       -
           Printf.sprintf "%s %s — %s [%s]%s" 

     

       313
       313
       +
           Printf.sprintf "%s %s — %s [%s]%s"

     

       312
       314
        
             talk_indicator

     

       313
       313
       -
             result.title 

     

       315
       315
       +
             result.title

     

       314
       316
        
             (format_date date)

     

       315
       317
        
             (if uuid = "" then result.id else uuid)

     

       316
       318
        
             url_display

     

       317
       317
       -
             

     

       319
       319
       +
       

     

       318
       320
        
         | "projects" ->

     

       319
       321
        
           let start_year = extract_field_string document "start_year" in

     

       320
       322
        
           let tags = extract_field_string_list document "tags" in

     

       321
       323
        
           let tags_str = match tags with [] -> "" | ts -> Printf.sprintf " #%s" (format_tags ts) in

     

       322
       322
       -
           Printf.sprintf "🚀 %s — %s%s" 

     

       323
       323
       -
             result.title 

     

       324
       324
       +
           Printf.sprintf "🚀 %s — %s%s"

     

       325
       325
       +
             result.title

     

       324
       326
        
             (if start_year = "" then "" else Printf.sprintf "(%s) " start_year)

     

       325
       327
        
             tags_str

     

       326
       326
       -
             

     

       328
       328
       +
       

     

       327
       329
        
         | "news" ->

     

       328
       330
        
           let date = extract_field_string document "date" in

     

       329
       331
        
           let url = extract_field_string document "url" in

     

       330
       332
        
           let url_display = if url = "" then "" else Printf.sprintf " <%s>" url in

     

       331
       331
       -
           Printf.sprintf "📰 %s — %s%s" 

     

       332
       332
       -
             result.title 

     

       333
       333
       +
           Printf.sprintf "📰 %s — %s%s"

     

       334
       334
       +
             result.title

     

       333
       335
        
             (format_date date)

     

       334
       336
        
             url_display

     

       335
       335
       -
             

     

       337
       337
       +
       

     

       336
       338
        
         | "notes" ->

     

       337
       339
        
           let date = extract_field_string document "date" in

     

       338
       340
        
           let tags = extract_field_string_list document "tags" in

     

       339
       341
        
           let tags_str = match tags with [] -> "" | ts -> Printf.sprintf " #%s" (format_tags ts) in

     

       340
       340
       -
           Printf.sprintf "📝 %s — %s%s" 

     

       341
       341
       -
             result.title 

     

       342
       342
       +
           Printf.sprintf "📝 %s — %s%s"

     

       343
       343
       +
             result.title

     

       342
       344
        
             (format_date date)

     

       343
       345
        
             tags_str

     

       344
       344
       -
             

     

       346
       346
       +
       

     

       345
       347
        
         | "ideas" ->

     

       346
       348
        
           let project = extract_field_string document "project" in

     

       347
       349
        
           let level = extract_field_string document "level" in

     

       348
       350
        
           let status = extract_field_string document "status" in

     

       349
       351
        
           let year = extract_field_string document "year" in

     

       350
       350
       -
           Printf.sprintf "💡 %s — %s%s%s %s" 

     

       351
       351
       -
             result.title 

     

       352
       352
       +
           Printf.sprintf "💡 %s — %s%s%s %s"

     

       353
       353
       +
             result.title

     

       352
       354
        
             (if project = "" then "" else Printf.sprintf "[%s] " project)

     

       353
       355
        
             (if level = "" then "" else Printf.sprintf "(%s) " level)

     

       354
       356
        
             (if status = "" then "" else Printf.sprintf "%s " status)

     

       355
       357
        
             year

     

       356
       356
       -
             

     

       358
       358
       +
       

     

       357
       359
        
         | "contacts" ->

     

       358
       360
        
           let names = extract_field_string_list document "names" in

     

       359
       361
        
           let handle = extract_field_string document "handle" in

     
···

       365
       367
        
             (if email = "" then "" else email);

     

       366
       368
        
             (if github = "" then "" else Printf.sprintf "github:%s" github);

     

       367
       369
        
           ] |> List.filter (fun s -> s <> "") |> String.concat " " in

     

       368
       368
       -
           Printf.sprintf "👤 %s — %s" 

     

       369
       369
       -
             name_str 

     

       370
       370
       +
           Printf.sprintf "👤 %s — %s"

     

       371
       371
       +
             name_str

     

       370
       372
        
             contact_info

     

       371
       371
       -
             

     

       372
       372
       -
         | _ -> Printf.sprintf "[%s] %s" result.collection result.title
     

       373
       373
       +
       

     

       374
       374
       +
         | _ -> Printf.sprintf "[%s] %s" result.collection result.title

-60

stack/bushel/typesense-client/typesense_client.mli

···

       1
       1
       -
       (** Standalone Typesense client for OCaml *)

     

       2
       2
       -
       

     

       3
       3
       -
       (** Configuration for Typesense client *)

     

       4
       4
       -
       type config = {

     

       5
       5
       -
         endpoint : string;

     

       6
       6
       -
         api_key : string;

     

       7
       7
       -
       }

     

       8
       8
       -
       

     

       9
       9
       -
       (** Error types for Typesense operations *)

     

       10
       10
       -
       type error = 

     

       11
       11
       -
         | Http_error of int * string

     

       12
       12
       -
         | Json_error of string

     

       13
       13
       -
         | Connection_error of string

     

       14
       14
       -
       

     

       15
       15
       -
       val pp_error : Format.formatter -> error -> unit

     

       16
       16
       -
       

     

       17
       17
       -
       (** Search result types *)

     

       18
       18
       -
       type search_result = {

     

       19
       19
       -
         id: string;

     

       20
       20
       -
         title: string;

     

       21
       21
       -
         content: string;

     

       22
       22
       -
         score: float;

     

       23
       23
       -
         collection: string;

     

       24
       24
       -
         highlights: (string * string list) list;

     

       25
       25
       -
         document: Ezjsonm.value;  (* Store raw document for flexible field access *)

     

       26
       26
       -
       }

     

       27
       27
       -
       

     

       28
       28
       -
       type search_response = {

     

       29
       29
       -
         hits: search_result list;

     

       30
       30
       -
         total: int;

     

       31
       31
       -
         query_time: float;

     

       32
       32
       -
       }

     

       33
       33
       -
       

     

       34
       34
       -
       (** Multisearch result types *)

     

       35
       35
       -
       type multisearch_response = {

     

       36
       36
       -
         results: search_response list;

     

       37
       37
       -
       }

     

       38
       38
       -
       

     

       39
       39
       -
       (** Search a single collection *)

     

       40
       40
       -
       val search_collection : config -> string -> string -> ?limit:int -> ?offset:int -> unit -> (search_response, error) result Lwt.t

     

       41
       41
       -
       

     

       42
       42
       -
       (** Perform multisearch across all collections *)

     

       43
       43
       -
       val multisearch : config -> string -> ?limit:int -> unit -> (multisearch_response, error) result Lwt.t

     

       44
       44
       -
       

     

       45
       45
       -
       (** Combine multisearch results into single result set *)

     

       46
       46
       -
       val combine_multisearch_results : multisearch_response -> ?limit:int -> ?offset:int -> unit -> search_response

     

       47
       47
       -
       

     

       48
       48
       -
       (** List all collections *)

     

       49
       49
       -
       val list_collections : config -> ((string * int) list, error) result Lwt.t

     

       50
       50
       -
       

     

       51
       51
       -
       (** Pretty printer utilities *)

     

       52
       52
       -
       val extract_field_string : Ezjsonm.value -> string -> string

     

       53
       53
       -
       val extract_field_string_list : Ezjsonm.value -> string -> string list

     

       54
       54
       -
       val extract_field_bool : Ezjsonm.value -> string -> bool

     

       55
       55
       -
       val format_authors : string list -> string

     

       56
       56
       -
       val format_date : string -> string

     

       57
       57
       -
       val format_tags : string list -> string

     

       58
       58
       -
       

     

       59
       59
       -
       (** One-line pretty printer for search results *)

     

       60
       60
       -
       val pp_search_result_oneline : search_result -> string

+195

stack/immiche/README.md

···

       1
       1
       +
       # Immiche - Immich API Client Library

     

       2
       2
       +
       

     

       3
       3
       +
       A clean Eio-based OCaml library for interacting with Immich instances, focusing on people and face recognition data.

     

       4
       4
       +
       

     

       5
       5
       +
       ## Overview

     

       6
       6
       +
       

     

       7
       7
       +
       Immiche provides a straightforward API for interacting with Immich's people management endpoints. It uses the Requests library for HTTP operations and follows Eio patterns for concurrency and resource management.

     

       8
       8
       +
       

     

       9
       9
       +
       ## Features

     

       10
       10
       +
       

     

       11
       11
       +
       - Fetch all people from an Immich instance

     

       12
       12
       +
       - Search for people by name

     

       13
       13
       +
       - Fetch individual person details

     

       14
       14
       +
       - Download person thumbnails

     

       15
       15
       +
       - Full Eio integration (no Lwt dependency)

     

       16
       16
       +
       - Type-safe API with result types for error handling

     

       17
       17
       +
       

     

       18
       18
       +
       ## API

     

       19
       19
       +
       

     

       20
       20
       +
       ### Types

     

       21
       21
       +
       

     

       22
       22
       +
       ```ocaml

     

       23
       23
       +
       (* Client type - encapsulates session with connection pooling *)

     

       24
       24
       +
       type ('clock, 'net) t

     

       25
       25
       +
       

     

       26
       26
       +
       type person = {

     

       27
       27
       +
         id: string;

     

       28
       28
       +
         name: string;

     

       29
       29
       +
         birth_date: string option;

     

       30
       30
       +
         thumbnail_path: string;

     

       31
       31
       +
         is_hidden: bool;

     

       32
       32
       +
       }

     

       33
       33
       +
       

     

       34
       34
       +
       type people_response = {

     

       35
       35
       +
         total: int;

     

       36
       36
       +
         visible: int;

     

       37
       37
       +
         people: person list;

     

       38
       38
       +
       }

     

       39
       39
       +
       ```

     

       40
       40
       +
       

     

       41
       41
       +
       ### Client Creation

     

       42
       42
       +
       

     

       43
       43
       +
       #### `create`

     

       44
       44
       +
       Create an Immich client with connection pooling.

     

       45
       45
       +
       

     

       46
       46
       +
       ```ocaml

     

       47
       47
       +
       val create :

     

       48
       48
       +
         sw:Eio.Switch.t ->

     

       49
       49
       +
         env:< clock: _ ; net: _ ; fs: _ ; .. > ->

     

       50
       50
       +
         ?requests_session:('clock, 'net) Requests.t ->

     

       51
       51
       +
         base_url:string ->

     

       52
       52
       +
         api_key:string ->

     

       53
       53
       +
         unit -> ('clock, 'net) t

     

       54
       54
       +
       ```

     

       55
       55
       +
       

     

       56
       56
       +
       **Parameters:**

     

       57
       57
       +
       - `sw` - Eio switch for resource management

     

       58
       58
       +
       - `env` - Eio environment (provides clock, net, fs)

     

       59
       59
       +
       - `requests_session` - Optional Requests session for connection pooling. If not provided, a new session is created.

     

       60
       60
       +
       - `base_url` - Base URL of the Immich instance (e.g., "https://photos.example.com")

     

       61
       61
       +
       - `api_key` - API key for authentication

     

       62
       62
       +
       

     

       63
       63
       +
       **Returns:** An Immich client configured for the specified instance

     

       64
       64
       +
       

     

       65
       65
       +
       ### API Functions

     

       66
       66
       +
       

     

       67
       67
       +
       All API functions take a client as their first parameter. The client automatically handles:

     

       68
       68
       +
       - Connection pooling (reuses TCP connections)

     

       69
       69
       +
       - Authentication (API key set as default header)

     

       70
       70
       +
       - Base URL configuration

     

       71
       71
       +
       

     

       72
       72
       +
       #### `fetch_people`

     

       73
       73
       +
       Fetch all people from an Immich instance.

     

       74
       74
       +
       

     

       75
       75
       +
       ```ocaml

     

       76
       76
       +
       val fetch_people : ('clock, 'net) t -> people_response

     

       77
       77
       +
       ```

     

       78
       78
       +
       

     

       79
       79
       +
       #### `search_person`

     

       80
       80
       +
       Search for people by name.

     

       81
       81
       +
       

     

       82
       82
       +
       ```ocaml

     

       83
       83
       +
       val search_person : ('clock, 'net) t -> name:string -> person list

     

       84
       84
       +
       ```

     

       85
       85
       +
       

     

       86
       86
       +
       #### `fetch_person`

     

       87
       87
       +
       Fetch details for a specific person.

     

       88
       88
       +
       

     

       89
       89
       +
       ```ocaml

     

       90
       90
       +
       val fetch_person : ('clock, 'net) t -> person_id:string -> person

     

       91
       91
       +
       ```

     

       92
       92
       +
       

     

       93
       93
       +
       #### `download_thumbnail`

     

       94
       94
       +
       Download a person's thumbnail image.

     

       95
       95
       +
       

     

       96
       96
       +
       ```ocaml

     

       97
       97
       +
       val download_thumbnail :

     

       98
       98
       +
         ('clock, 'net) t ->

     

       99
       99
       +
         fs:_ Eio.Path.t ->

     

       100
       100
       +
         person_id:string ->

     

       101
       101
       +
         output_path:string ->

     

       102
       102
       +
         (unit, [> `Msg of string]) result

     

       103
       103
       +
       ```

     

       104
       104
       +
       

     

       105
       105
       +
       ## Example Usage

     

       106
       106
       +
       

     

       107
       107
       +
       ### Basic Usage

     

       108
       108
       +
       

     

       109
       109
       +
       ```ocaml

     

       110
       110
       +
       open Eio.Std

     

       111
       111
       +
       

     

       112
       112
       +
       let () =

     

       113
       113
       +
         Eio_main.run @@ fun env ->

     

       114
       114
       +
         Switch.run @@ fun sw ->

     

       115
       115
       +
       

     

       116
       116
       +
         (* Create client once with connection pooling *)

     

       117
       117
       +
         let client = Immiche.create ~sw ~env

     

       118
       118
       +
           ~base_url:"https://photos.example.com"

     

       119
       119
       +
           ~api_key:"your-api-key" () in

     

       120
       120
       +
       

     

       121
       121
       +
         (* Fetch all people - connection pooling automatic *)

     

       122
       122
       +
         let response = Immiche.fetch_people client in

     

       123
       123
       +
         Printf.printf "Total people: %d\n" response.total;

     

       124
       124
       +
       

     

       125
       125
       +
         (* Search for a person - reuses connections *)

     

       126
       126
       +
         let results = Immiche.search_person client ~name:"John" in

     

       127
       127
       +
       

     

       128
       128
       +
         (* Download first result's thumbnail *)

     

       129
       129
       +
         match results with

     

       130
       130
       +
         | person :: _ ->

     

       131
       131
       +
             let result = Immiche.download_thumbnail client

     

       132
       132
       +
               ~fs:(Eio.Stdenv.fs env)

     

       133
       133
       +
               ~person_id:person.id

     

       134
       134
       +
               ~output_path:"thumbnail.jpg" in

     

       135
       135
       +
             begin match result with

     

       136
       136
       +
             | Ok () -> print_endline "Thumbnail downloaded!"

     

       137
       137
       +
             | Error (`Msg err) -> Printf.eprintf "Error: %s\n" err

     

       138
       138
       +
             end

     

       139
       139
       +
         | [] -> print_endline "No results found"

     

       140
       140
       +
       ```

     

       141
       141
       +
       

     

       142
       142
       +
       ### Sharing Connection Pools

     

       143
       143
       +
       

     

       144
       144
       +
       You can share a `Requests.t` session across multiple API clients for maximum connection reuse:

     

       145
       145
       +
       

     

       146
       146
       +
       ```ocaml

     

       147
       147
       +
       Eio_main.run @@ fun env ->

     

       148
       148
       +
       Switch.run @@ fun sw ->

     

       149
       149
       +
       

     

       150
       150
       +
         (* Create shared Requests session *)

     

       151
       151
       +
         let shared_session = Requests.create ~sw env in

     

       152
       152
       +
       

     

       153
       153
       +
         (* Create multiple clients sharing the same connection pools *)

     

       154
       154
       +
         let immich1 = Immiche.create ~sw ~env ~requests_session:shared_session

     

       155
       155
       +
           ~base_url:"https://photos1.example.com"

     

       156
       156
       +
           ~api_key:"key1" () in

     

       157
       157
       +
       

     

       158
       158
       +
         let immich2 = Immiche.create ~sw ~env ~requests_session:shared_session

     

       159
       159
       +
           ~base_url:"https://photos2.example.com"

     

       160
       160
       +
           ~api_key:"key2" () in

     

       161
       161
       +
       

     

       162
       162
       +
         (* Both clients share the same connection pools! *)

     

       163
       163
       +
         let people1 = Immiche.fetch_people immich1 in

     

       164
       164
       +
         let people2 = Immiche.fetch_people immich2 in

     

       165
       165
       +
         ()

     

       166
       166
       +
       ```

     

       167
       167
       +
       

     

       168
       168
       +
       ## Dependencies

     

       169
       169
       +
       

     

       170
       170
       +
       - `eio` - Concurrent I/O library

     

       171
       171
       +
       - `requests` - HTTP client library

     

       172
       172
       +
       - `ezjsonm` - JSON parsing

     

       173
       173
       +
       - `uri` - URI encoding

     

       174
       174
       +
       - `fmt` - Formatting

     

       175
       175
       +
       - `ptime` - Time handling

     

       176
       176
       +
       

     

       177
       177
       +
       ## Implementation Notes

     

       178
       178
       +
       

     

       179
       179
       +
       - Uses `Requests.t` for session-based HTTP requests with connection pooling

     

       180
       180
       +
       - Authentication via `x-api-key` header (set as default on session creation)

     

       181
       181
       +
       - Direct Eio style - no Lwt dependencies

     

       182
       182
       +
       - Connection pools shared across derived sessions

     

       183
       183
       +
       - Extracted and adapted from `bushel/bin/bushel_faces.ml`

     

       184
       184
       +
       

     

       185
       185
       +
       ## Benefits

     

       186
       186
       +
       

     

       187
       187
       +
       ✅ **Connection Pooling** - Automatic TCP connection reuse across requests

     

       188
       188
       +
       ✅ **Clean API** - Session-level configuration passed once, not per-request

     

       189
       189
       +
       ✅ **Injectable Sessions** - Can share `Requests.t` across multiple libraries

     

       190
       190
       +
       ✅ **Type Safety** - Client parameterized by clock/net types

     

       191
       191
       +
       ✅ **Immutable Configuration** - Derived sessions don't affect original

     

       192
       192
       +
       

     

       193
       193
       +
       ## License

     

       194
       194
       +
       

     

       195
       195
       +
       ISC

stack/immiche/dune

···

       1
       1
       +
       (library

     

       2
       2
       +
        (name immiche)

     

       3
       3
       +
        (public_name immiche)

     

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

+19

stack/immiche/dune-project

···

       1
       1
       +
       (lang dune 3.0)

     

       2
       2
       +
       (name immiche)

     

       3
       3
       +
       (version 0.1.0)

     

       4
       4
       +
       

     

       5
       5
       +
       (generate_opam_files true)

     

       6
       6
       +
       

     

       7
       7
       +
       (package

     

       8
       8
       +
        (name immiche)

     

       9
       9
       +
        (synopsis "Immich API client for OCaml using Eio")

     

       10
       10
       +
        (description "An Eio-based OCaml client library for Immich photo service API")

     

       11
       11
       +
        (depends

     

       12
       12
       +
         (ocaml (>= 4.14))

     

       13
       13
       +
         eio

     

       14
       14
       +
         (eio_main (>= 1.0))

     

       15
       15
       +
         requests

     

       16
       16
       +
         ezjsonm

     

       17
       17
       +
         fmt

     

       18
       18
       +
         ptime

     

       19
       19
       +
         uri))

+137

stack/immiche/immiche.ml

···

       1
       1
       +
       (** Immiche - Immich API client library *)

     

       2
       2
       +
       

     

       3
       3
       +
       open Printf

     

       4
       4
       +
       

     

       5
       5
       +
       (** {1 Types} *)

     

       6
       6
       +
       

     

       7
       7
       +
       type ('clock, 'net) t = {

     

       8
       8
       +
         base_url: string;

     

       9
       9
       +
         api_key: string;

     

       10
       10
       +
         requests_session: ('clock, 'net) Requests.t;

     

       11
       11
       +
       }

     

       12
       12
       +
       

     

       13
       13
       +
       type person = {

     

       14
       14
       +
         id: string;

     

       15
       15
       +
         name: string;

     

       16
       16
       +
         birth_date: string option;

     

       17
       17
       +
         thumbnail_path: string;

     

       18
       18
       +
         is_hidden: bool;

     

       19
       19
       +
       }

     

       20
       20
       +
       

     

       21
       21
       +
       type people_response = {

     

       22
       22
       +
         total: int;

     

       23
       23
       +
         visible: int;

     

       24
       24
       +
         people: person list;

     

       25
       25
       +
       }

     

       26
       26
       +
       

     

       27
       27
       +
       (** {1 Client Creation} *)

     

       28
       28
       +
       

     

       29
       29
       +
       let create ~sw ~env ?requests_session ~base_url ~api_key () =

     

       30
       30
       +
         let requests_session = match requests_session with

     

       31
       31
       +
           | Some session -> session

     

       32
       32
       +
           | None -> Requests.create ~sw env

     

       33
       33
       +
         in

     

       34
       34
       +
         (* Set API key header on the session *)

     

       35
       35
       +
         let requests_session = Requests.set_default_header requests_session "x-api-key" api_key in

     

       36
       36
       +
         { base_url; api_key; requests_session }

     

       37
       37
       +
       

     

       38
       38
       +
       (** {1 JSON Parsing} *)

     

       39
       39
       +
       

     

       40
       40
       +
       (* Parse a single person from JSON *)

     

       41
       41
       +
       let parse_person json =

     

       42
       42
       +
         let open Ezjsonm in

     

       43
       43
       +
         let id = find json ["id"] |> get_string in

     

       44
       44
       +
         let name = find json ["name"] |> get_string in

     

       45
       45
       +
         let birth_date =

     

       46
       46
       +
           try Some (find json ["birthDate"] |> get_string)

     

       47
       47
       +
           with _ -> None

     

       48
       48
       +
         in

     

       49
       49
       +
         let thumbnail_path = find json ["thumbnailPath"] |> get_string in

     

       50
       50
       +
         let is_hidden =

     

       51
       51
       +
           try find json ["isHidden"] |> get_bool

     

       52
       52
       +
           with _ -> false

     

       53
       53
       +
         in

     

       54
       54
       +
         { id; name; birth_date; thumbnail_path; is_hidden }

     

       55
       55
       +
       

     

       56
       56
       +
       (* Parse people response from JSON *)

     

       57
       57
       +
       let parse_people_response json =

     

       58
       58
       +
         let open Ezjsonm in

     

       59
       59
       +
         let total = find json ["total"] |> get_int in

     

       60
       60
       +
         let visible = find json ["visible"] |> get_int in

     

       61
       61
       +
         let people_json = find json ["people"] in

     

       62
       62
       +
         let people = get_list parse_person people_json in

     

       63
       63
       +
         { total; visible; people }

     

       64
       64
       +
       

     

       65
       65
       +
       (* Parse a list of people from search results *)

     

       66
       66
       +
       let parse_person_list json =

     

       67
       67
       +
         let open Ezjsonm in

     

       68
       68
       +
         get_list parse_person json

     

       69
       69
       +
       

     

       70
       70
       +
       (** {1 API Functions} *)

     

       71
       71
       +
       

     

       72
       72
       +
       let fetch_people { base_url; requests_session; _ } =

     

       73
       73
       +
         let url = sprintf "%s/api/people" base_url in

     

       74
       74
       +
       

     

       75
       75
       +
         let response = Requests.get requests_session url in

     

       76
       76
       +
         let status = Requests.Response.status_code response in

     

       77
       77
       +
       

     

       78
       78
       +
         if status <> 200 then

     

       79
       79
       +
           failwith (sprintf "HTTP error: %d" status)

     

       80
       80
       +
         else

     

       81
       81
       +
           let body_str = Requests.Response.body response |> Eio.Flow.read_all in

     

       82
       82
       +
           let json = Ezjsonm.from_string body_str in

     

       83
       83
       +
           parse_people_response json

     

       84
       84
       +
       

     

       85
       85
       +
       let fetch_person { base_url; requests_session; _ } ~person_id =

     

       86
       86
       +
         let url = sprintf "%s/api/people/%s" base_url person_id in

     

       87
       87
       +
       

     

       88
       88
       +
         let response = Requests.get requests_session url in

     

       89
       89
       +
         let status = Requests.Response.status_code response in

     

       90
       90
       +
       

     

       91
       91
       +
         if status <> 200 then

     

       92
       92
       +
           failwith (sprintf "HTTP error: %d" status)

     

       93
       93
       +
         else

     

       94
       94
       +
           let body_str = Requests.Response.body response |> Eio.Flow.read_all in

     

       95
       95
       +
           let json = Ezjsonm.from_string body_str in

     

       96
       96
       +
           parse_person json

     

       97
       97
       +
       

     

       98
       98
       +
       let download_thumbnail { base_url; requests_session; _ } ~fs ~person_id ~output_path =

     

       99
       99
       +
         try

     

       100
       100
       +
           let url = sprintf "%s/api/people/%s/thumbnail" base_url person_id in

     

       101
       101
       +
       

     

       102
       102
       +
           let response = Requests.get requests_session url in

     

       103
       103
       +
           let status = Requests.Response.status_code response in

     

       104
       104
       +
       

     

       105
       105
       +
           if status <> 200 then

     

       106
       106
       +
             Error (`Msg (sprintf "HTTP error: %d" status))

     

       107
       107
       +
           else begin

     

       108
       108
       +
             let img_data = Requests.Response.body response |> Eio.Flow.read_all in

     

       109
       109
       +
       

     

       110
       110
       +
             (* Ensure output directory exists *)

     

       111
       111
       +
             let dir = Filename.dirname output_path in

     

       112
       112
       +
             if not (Sys.file_exists dir) then

     

       113
       113
       +
               Unix.mkdir dir 0o755;

     

       114
       114
       +
       

     

       115
       115
       +
             (* Write the image data to file *)

     

       116
       116
       +
             let path = Eio.Path.(fs / output_path) in

     

       117
       117
       +
             Eio.Path.save ~create:(`Or_truncate 0o644) path img_data;

     

       118
       118
       +
       

     

       119
       119
       +
             Ok ()

     

       120
       120
       +
           end

     

       121
       121
       +
         with

     

       122
       122
       +
         | Failure msg -> Error (`Msg msg)

     

       123
       123
       +
         | exn -> Error (`Msg (Printexc.to_string exn))

     

       124
       124
       +
       

     

       125
       125
       +
       let search_person { base_url; requests_session; _ } ~name =

     

       126
       126
       +
         let encoded_name = Uri.pct_encode name in

     

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

     

       128
       128
       +
       

     

       129
       129
       +
         let response = Requests.get requests_session url in

     

       130
       130
       +
         let status = Requests.Response.status_code response in

     

       131
       131
       +
       

     

       132
       132
       +
         if status <> 200 then

     

       133
       133
       +
           failwith (sprintf "HTTP error: %d" status)

     

       134
       134
       +
         else

     

       135
       135
       +
           let body_str = Requests.Response.body response |> Eio.Flow.read_all in

     

       136
       136
       +
           let json = Ezjsonm.from_string body_str in

     

       137
       137
       +
           parse_person_list json

+100

stack/immiche/immiche.mli

···

       1
       1
       +
       (** Immiche - Immich API client library

     

       2
       2
       +
       

     

       3
       3
       +
           This library provides a clean Eio-based interface to interact with Immich

     

       4
       4
       +
           instances for managing people and face recognition data.

     

       5
       5
       +
       *)

     

       6
       6
       +
       

     

       7
       7
       +
       (** {1 Types} *)

     

       8
       8
       +
       

     

       9
       9
       +
       (** Type representing an Immich client with connection pooling *)

     

       10
       10
       +
       type ('clock, 'net) t

     

       11
       11
       +
       

     

       12
       12
       +
       (** Type representing a person in Immich *)

     

       13
       13
       +
       type person = {

     

       14
       14
       +
         id: string;

     

       15
       15
       +
         name: string;

     

       16
       16
       +
         birth_date: string option;

     

       17
       17
       +
         thumbnail_path: string;

     

       18
       18
       +
         is_hidden: bool;

     

       19
       19
       +
       }

     

       20
       20
       +
       

     

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

     

       22
       22
       +
       type people_response = {

     

       23
       23
       +
         total: int;

     

       24
       24
       +
         visible: int;

     

       25
       25
       +
         people: person list;

     

       26
       26
       +
       }

     

       27
       27
       +
       

     

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

     

       29
       29
       +
       

     

       30
       30
       +
       (** [create ~sw ~env ?requests_session ~base_url ~api_key ()] creates a new Immich client.

     

       31
       31
       +
       

     

       32
       32
       +
           @param sw The Eio switch for resource management

     

       33
       33
       +
           @param env The Eio environment (provides clock, net, fs)

     

       34
       34
       +
           @param requests_session Optional Requests session for connection pooling.

     

       35
       35
       +
                                  If not provided, a new session is created.

     

       36
       36
       +
           @param base_url The base URL of the Immich instance (e.g., "https://photos.example.com")

     

       37
       37
       +
           @param api_key The API key for authentication

     

       38
       38
       +
           @return An Immich client configured for the specified instance

     

       39
       39
       +
       *)

     

       40
       40
       +
       val create :

     

       41
       41
       +
         sw:Eio.Switch.t ->

     

       42
       42
       +
         env:< clock: ([> float Eio.Time.clock_ty ] as 'clock) Eio.Resource.t;

     

       43
       43
       +
               net: ([> [> `Generic ] Eio.Net.ty ] as 'net) Eio.Resource.t;

     

       44
       44
       +
               fs: Eio.Fs.dir_ty Eio.Path.t; .. > ->

     

       45
       45
       +
         ?requests_session:('clock Eio.Resource.t, 'net Eio.Resource.t) Requests.t ->

     

       46
       46
       +
         base_url:string ->

     

       47
       47
       +
         api_key:string ->

     

       48
       48
       +
         unit -> ('clock Eio.Resource.t, 'net Eio.Resource.t) t

     

       49
       49
       +
       

     

       50
       50
       +
       (** {1 API Functions} *)

     

       51
       51
       +
       

     

       52
       52
       +
       (** [fetch_people client] fetches all people from an Immich instance.

     

       53
       53
       +
       

     

       54
       54
       +
           @param client The Immich client

     

       55
       55
       +
           @return A people_response containing all people and metadata

     

       56
       56
       +
           @raise Failure if the API request fails

     

       57
       57
       +
       *)

     

       58
       58
       +
       val fetch_people :

     

       59
       59
       +
         ([> float Eio.Time.clock_ty ] Eio.Resource.t, [> [> `Generic ] Eio.Net.ty ] Eio.Resource.t) t ->

     

       60
       60
       +
         people_response

     

       61
       61
       +
       

     

       62
       62
       +
       (** [fetch_person client ~person_id] fetches details for a single person.

     

       63
       63
       +
       

     

       64
       64
       +
           @param client The Immich client

     

       65
       65
       +
           @param person_id The ID of the person to fetch

     

       66
       66
       +
           @return The person details

     

       67
       67
       +
           @raise Failure if the API request fails or person not found

     

       68
       68
       +
       *)

     

       69
       69
       +
       val fetch_person :

     

       70
       70
       +
         ([> float Eio.Time.clock_ty ] Eio.Resource.t, [> [> `Generic ] Eio.Net.ty ] Eio.Resource.t) t ->

     

       71
       71
       +
         person_id:string ->

     

       72
       72
       +
         person

     

       73
       73
       +
       

     

       74
       74
       +
       (** [download_thumbnail client ~fs ~person_id ~output_path] downloads

     

       75
       75
       +
           a person's thumbnail image to a file.

     

       76
       76
       +
       

     

       77
       77
       +
           @param client The Immich client

     

       78
       78
       +
           @param fs The Eio filesystem capability

     

       79
       79
       +
           @param person_id The ID of the person whose thumbnail to download

     

       80
       80
       +
           @param output_path The file path where the thumbnail should be saved

     

       81
       81
       +
           @return Ok () on success, or Error with a message on failure

     

       82
       82
       +
       *)

     

       83
       83
       +
       val download_thumbnail :

     

       84
       84
       +
         ([> float Eio.Time.clock_ty ] Eio.Resource.t, [> [> `Generic ] Eio.Net.ty ] Eio.Resource.t) t ->

     

       85
       85
       +
         fs:_ Eio.Path.t ->

     

       86
       86
       +
         person_id:string ->

     

       87
       87
       +
         output_path:string ->

     

       88
       88
       +
         (unit, [> `Msg of string]) result

     

       89
       89
       +
       

     

       90
       90
       +
       (** [search_person client ~name] searches for people by name.

     

       91
       91
       +
       

     

       92
       92
       +
           @param client The Immich client

     

       93
       93
       +
           @param name The name to search for

     

       94
       94
       +
           @return A list of matching people

     

       95
       95
       +
           @raise Failure if the API request fails

     

       96
       96
       +
       *)

     

       97
       97
       +
       val search_person :

     

       98
       98
       +
         ([> float Eio.Time.clock_ty ] Eio.Resource.t, [> [> `Generic ] Eio.Net.ty ] Eio.Resource.t) t ->

     

       99
       99
       +
         name:string ->

     

       100
       100
       +
         person list

+31

stack/immiche/immiche.opam

···

       1
       1
       +
       # This file is generated by dune, edit dune-project instead

     

       2
       2
       +
       opam-version: "2.0"

     

       3
       3
       +
       version: "0.1.0"

     

       4
       4
       +
       synopsis: "Immich API client for OCaml using Eio"

     

       5
       5
       +
       description: "An Eio-based OCaml client library for Immich photo service API"

     

       6
       6
       +
       depends: [

     

       7
       7
       +
         "dune" {>= "3.0"}

     

       8
       8
       +
         "ocaml" {>= "4.14"}

     

       9
       9
       +
         "eio"

     

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

     

       11
       11
       +
         "requests"

     

       12
       12
       +
         "ezjsonm"

     

       13
       13
       +
         "fmt"

     

       14
       14
       +
         "ptime"

     

       15
       15
       +
         "uri"

     

       16
       16
       +
         "odoc" {with-doc}

     

       17
       17
       +
       ]

     

       18
       18
       +
       build: [

     

       19
       19
       +
         ["dune" "subst"] {dev}

     

       20
       20
       +
         [

     

       21
       21
       +
           "dune"

     

       22
       22
       +
           "build"

     

       23
       23
       +
           "-p"

     

       24
       24
       +
           name

     

       25
       25
       +
           "-j"

     

       26
       26
       +
           jobs

     

       27
       27
       +
           "@install"

     

       28
       28
       +
           "@runtest" {with-test}

     

       29
       29
       +
           "@doc" {with-doc}

     

       30
       30
       +
         ]

     

       31
       31
       +
       ]

+5 -4

stack/jmap/jmap-client/jmap_client.ml

···

       12
       12
        
         let requests_session = Requests.create ~sw env in

     

       13
       13
        
       

     

       14
       14
        
         (* Set authentication if configured *)

     

       15
       15
       -
         (match Jmap_connection.auth conn with

     

       15
       15
       +
         let requests_session = match Jmap_connection.auth conn with

     

       16
       16
        
          | Some (Jmap_connection.Bearer token) ->

     

       17
       17
        
              Requests.set_auth requests_session (Requests.Auth.bearer ~token)

     

       18
       18
        
          | Some (Jmap_connection.Basic (user, pass)) ->

     

       19
       19
        
              Requests.set_auth requests_session (Requests.Auth.basic ~username:user ~password:pass)

     

       20
       20
       -
          | None -> ());

     

       20
       20
       +
          | None -> requests_session

     

       21
       21
       +
         in

     

       21
       22
        
       

     

       22
       23
        
         (* Set user agent *)

     

       23
       24
        
         let config = Jmap_connection.config conn in

     

       24
       24
       -
         Requests.set_default_header requests_session "User-Agent"

     

       25
       25
       -
           (Jmap_connection.user_agent config);

     

       25
       25
       +
         let requests_session = Requests.set_default_header requests_session "User-Agent"

     

       26
       26
       +
           (Jmap_connection.user_agent config) in

     

       26
       27
        
       

     

       27
       28
        
         { session_url;

     

       28
       29
        
           get_request = (fun ~timeout url -> Requests.get requests_session ~timeout url);

stack/karakeepe/dune

···

       1
       1
       +
       (library

     

       2
       2
       +
        (name karakeepe)

     

       3
       3
       +
        (public_name karakeepe)

     

       4
       4
       +
        (libraries bushel eio eio.core requests ezjsonm fmt ptime uri))

+19

stack/karakeepe/dune-project

···

       1
       1
       +
       (lang dune 3.0)

     

       2
       2
       +
       (name karakeepe)

     

       3
       3
       +
       (version 0.1.0)

     

       4
       4
       +
       

     

       5
       5
       +
       (generate_opam_files true)

     

       6
       6
       +
       

     

       7
       7
       +
       (package

     

       8
       8
       +
        (name karakeepe)

     

       9
       9
       +
        (synopsis "Karakeep API client for OCaml using Eio")

     

       10
       10
       +
        (description "An Eio-based OCaml client library for the Karakeep bookmark management service API")

     

       11
       11
       +
        (depends

     

       12
       12
       +
         (ocaml (>= 4.14))

     

       13
       13
       +
         eio

     

       14
       14
       +
         (eio_main (>= 1.0))

     

       15
       15
       +
         requests

     

       16
       16
       +
         ezjsonm

     

       17
       17
       +
         fmt

     

       18
       18
       +
         ptime

     

       19
       19
       +
         uri))

+472

stack/karakeepe/karakeepe.ml

···

       1
       1
       +
       (** Karakeepe API client implementation (Eio version) *)

     

       2
       2
       +
       

     

       3
       3
       +
       module J = Ezjsonm

     

       4
       4
       +
       

     

       5
       5
       +
       (** Type representing a Karakeep bookmark *)

     

       6
       6
       +
       type bookmark = {

     

       7
       7
       +
         id: string;

     

       8
       8
       +
         title: string option;

     

       9
       9
       +
         url: string;

     

       10
       10
       +
         note: string option;

     

       11
       11
       +
         created_at: Ptime.t;

     

       12
       12
       +
         updated_at: Ptime.t option;

     

       13
       13
       +
         favourited: bool;

     

       14
       14
       +
         archived: bool;

     

       15
       15
       +
         tags: string list;

     

       16
       16
       +
         tagging_status: string option;

     

       17
       17
       +
         summary: string option;

     

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

     

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

     

       20
       20
       +
       }

     

       21
       21
       +
       

     

       22
       22
       +
       (** Type for Karakeep API response containing bookmarks *)

     

       23
       23
       +
       type bookmark_response = {

     

       24
       24
       +
         total: int;

     

       25
       25
       +
         data: bookmark list;

     

       26
       26
       +
         next_cursor: string option;

     

       27
       27
       +
       }

     

       28
       28
       +
       

     

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

     

       30
       30
       +
       let parse_date str =

     

       31
       31
       +
         match Ptime.of_rfc3339 str with

     

       32
       32
       +
         | Ok (date, _, _) -> date

     

       33
       33
       +
         | Error _ ->

     

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

     

       35
       35
       +
             (* Default to epoch time *)

     

       36
       36
       +
             let span_opt = Ptime.Span.of_d_ps (0, 0L) in

     

       37
       37
       +
             match span_opt with

     

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

     

       39
       39
       +
             | Some span ->

     

       40
       40
       +
               match Ptime.of_span span with

     

       41
       41
       +
               | Some t -> t

     

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

     

       43
       43
       +
       

     

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

     

       45
       45
       +
       let get_string_opt json path =

     

       46
       46
       +
         try Some (J.find json path |> J.get_string)

     

       47
       47
       +
         with _ -> None

     

       48
       48
       +
       

     

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

     

       50
       50
       +
       let get_string_list json path =

     

       51
       51
       +
         try

     

       52
       52
       +
           let items_json = J.find json path in

     

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

     

       54
       54
       +
         with _ -> []

     

       55
       55
       +
       

     

       56
       56
       +
       (** Extract a boolean field from JSON, with default value *)

     

       57
       57
       +
       let get_bool_def json path default =

     

       58
       58
       +
         try J.find json path |> J.get_bool

     

       59
       59
       +
         with _ -> default

     

       60
       60
       +
       

     

       61
       61
       +
       (** Parse a single bookmark from Karakeep JSON *)

     

       62
       62
       +
       let parse_bookmark json =

     

       63
       63
       +
         let id =

     

       64
       64
       +
           try J.find json ["id"] |> J.get_string

     

       65
       65
       +
           with e ->

     

       66
       66
       +
             prerr_endline (Fmt.str "Error parsing bookmark ID: %s" (Printexc.to_string e));

     

       67
       67
       +
             prerr_endline (Fmt.str "JSON: %s" (J.value_to_string json));

     

       68
       68
       +
             failwith "Unable to parse bookmark ID"

     

       69
       69
       +
         in

     

       70
       70
       +
       

     

       71
       71
       +
         let title =

     

       72
       72
       +
           try Some (J.find json ["title"] |> J.get_string)

     

       73
       73
       +
           with _ -> None

     

       74
       74
       +
         in

     

       75
       75
       +
       

     

       76
       76
       +
         let url =

     

       77
       77
       +
           try J.find json ["url"] |> J.get_string

     

       78
       78
       +
           with _ -> try

     

       79
       79
       +
             J.find json ["content"; "url"] |> J.get_string

     

       80
       80
       +
           with _ -> try

     

       81
       81
       +
             J.find json ["content"; "sourceUrl"] |> J.get_string

     

       82
       82
       +
           with _ ->

     

       83
       83
       +
             match J.find_opt json ["content"; "type"] with

     

       84
       84
       +
             | Some (`String "asset") ->

     

       85
       85
       +
                 (try J.find json ["content"; "sourceUrl"] |> J.get_string

     

       86
       86
       +
                  with _ ->

     

       87
       87
       +
                    (match J.find_opt json ["id"] with

     

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

     

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

     

       90
       90
       +
             | _ ->

     

       91
       91
       +
                 prerr_endline (Fmt.str "Bookmark JSON structure: %s" (J.value_to_string json));

     

       92
       92
       +
                 failwith "No URL found in bookmark"

     

       93
       93
       +
         in

     

       94
       94
       +
       

     

       95
       95
       +
         let note = get_string_opt json ["note"] in

     

       96
       96
       +
       

     

       97
       97
       +
         let created_at =

     

       98
       98
       +
           try J.find json ["createdAt"] |> J.get_string |> parse_date

     

       99
       99
       +
           with _ ->

     

       100
       100
       +
             try J.find json ["created_at"] |> J.get_string |> parse_date

     

       101
       101
       +
             with _ -> failwith "No creation date found"

     

       102
       102
       +
         in

     

       103
       103
       +
       

     

       104
       104
       +
         let updated_at =

     

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

     

       106
       106
       +
           with _ ->

     

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

     

       108
       108
       +
             with _ -> None

     

       109
       109
       +
         in

     

       110
       110
       +
       

     

       111
       111
       +
         let favourited = get_bool_def json ["favourited"] false in

     

       112
       112
       +
         let archived = get_bool_def json ["archived"] false in

     

       113
       113
       +
         let tags = get_string_list json ["tags"] in

     

       114
       114
       +
         let tagging_status = get_string_opt json ["taggingStatus"] in

     

       115
       115
       +
         let summary = get_string_opt json ["summary"] in

     

       116
       116
       +
       

     

       117
       117
       +
         let content =

     

       118
       118
       +
           try

     

       119
       119
       +
             let content_json = J.find json ["content"] in

     

       120
       120
       +
             let rec extract_fields acc = function

     

       121
       121
       +
               | [] -> acc

     

       122
       122
       +
               | (k, v) :: rest ->

     

       123
       123
       +
                   let value = match v with

     

       124
       124
       +
                     | `String s -> s

     

       125
       125
       +
                     | `Bool b -> string_of_bool b

     

       126
       126
       +
                     | `Float f -> string_of_float f

     

       127
       127
       +
                     | `Null -> "null"

     

       128
       128
       +
                     | _ -> "complex_value"

     

       129
       129
       +
                   in

     

       130
       130
       +
                   extract_fields ((k, value) :: acc) rest

     

       131
       131
       +
             in

     

       132
       132
       +
             match content_json with

     

       133
       133
       +
             | `O fields -> extract_fields [] fields

     

       134
       134
       +
             | _ -> []

     

       135
       135
       +
           with _ -> []

     

       136
       136
       +
         in

     

       137
       137
       +
       

     

       138
       138
       +
         let assets =

     

       139
       139
       +
           try

     

       140
       140
       +
             let assets_json = J.find json ["assets"] in

     

       141
       141
       +
             J.get_list (fun asset_json ->

     

       142
       142
       +
               let id = J.find asset_json ["id"] |> J.get_string in

     

       143
       143
       +
               let asset_type =

     

       144
       144
       +
                 try J.find asset_json ["assetType"] |> J.get_string

     

       145
       145
       +
                 with _ -> "unknown"

     

       146
       146
       +
               in

     

       147
       147
       +
               (id, asset_type)

     

       148
       148
       +
             ) assets_json

     

       149
       149
       +
           with _ -> []

     

       150
       150
       +
         in

     

       151
       151
       +
       

     

       152
       152
       +
         { id; title; url; note; created_at; updated_at; favourited; archived; tags;

     

       153
       153
       +
           tagging_status; summary; content; assets }

     

       154
       154
       +
       

     

       155
       155
       +
       (** Parse a Karakeep bookmark response *)

     

       156
       156
       +
       let parse_bookmark_response json =

     

       157
       157
       +
         prerr_endline (Fmt.str "Full response JSON: %s" (J.value_to_string json));

     

       158
       158
       +
       

     

       159
       159
       +
         try

     

       160
       160
       +
           let total = J.find json ["total"] |> J.get_int in

     

       161
       161
       +
           let bookmarks_json = J.find json ["data"] in

     

       162
       162
       +
           prerr_endline "Found bookmarks in data array";

     

       163
       163
       +
           let data = J.get_list parse_bookmark bookmarks_json in

     

       164
       164
       +
           let next_cursor =

     

       165
       165
       +
             try Some (J.find json ["nextCursor"] |> J.get_string)

     

       166
       166
       +
             with _ -> None

     

       167
       167
       +
           in

     

       168
       168
       +
           { total; data; next_cursor }

     

       169
       169
       +
         with e1 ->

     

       170
       170
       +
           prerr_endline (Fmt.str "First format parse error: %s" (Printexc.to_string e1));

     

       171
       171
       +
           try

     

       172
       172
       +
             let bookmarks_json = J.find json ["bookmarks"] in

     

       173
       173
       +
             prerr_endline "Found bookmarks in bookmarks array";

     

       174
       174
       +
             let data =

     

       175
       175
       +
               try J.get_list parse_bookmark bookmarks_json

     

       176
       176
       +
               with e ->

     

       177
       177
       +
                 prerr_endline (Fmt.str "Error parsing bookmarks array: %s" (Printexc.to_string e));

     

       178
       178
       +
                 []

     

       179
       179
       +
             in

     

       180
       180
       +
             let next_cursor =

     

       181
       181
       +
               try Some (J.find json ["nextCursor"] |> J.get_string)

     

       182
       182
       +
               with _ -> None

     

       183
       183
       +
             in

     

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

     

       185
       185
       +
           with e2 ->

     

       186
       186
       +
             prerr_endline (Fmt.str "Second format parse error: %s" (Printexc.to_string e2));

     

       187
       187
       +
             try

     

       188
       188
       +
               let error = J.find json ["error"] |> J.get_string in

     

       189
       189
       +
               let message =

     

       190
       190
       +
                 try J.find json ["message"] |> J.get_string

     

       191
       191
       +
                 with _ -> "Unknown error"

     

       192
       192
       +
               in

     

       193
       193
       +
               prerr_endline (Fmt.str "API Error: %s - %s" error message);

     

       194
       194
       +
               { total = 0; data = []; next_cursor = None }

     

       195
       195
       +
             with _ ->

     

       196
       196
       +
               try

     

       197
       197
       +
                 prerr_endline "Trying alternate array format";

     

       198
       198
       +
                 prerr_endline (Fmt.str "JSON structure keys: %s"

     

       199
       199
       +
                   (match json with

     

       200
       200
       +
                    | `O fields -> String.concat ", " (List.map (fun (k, _) -> k) fields)

     

       201
       201
       +
                    | _ -> "not an object"));

     

       202
       202
       +
       

     

       203
       203
       +
                 if J.find_opt json ["nextCursor"] <> None then begin

     

       204
       204
       +
                   prerr_endline "Found nextCursor, checking alternate structures";

     

       205
       205
       +
                   let bookmarks_json =

     

       206
       206
       +
                     try Some (J.find json ["data"])

     

       207
       207
       +
                     with _ -> None

     

       208
       208
       +
                   in

     

       209
       209
       +
                   match bookmarks_json with

     

       210
       210
       +
                   | Some json_array ->

     

       211
       211
       +
                       prerr_endline "Found bookmarks in data field";

     

       212
       212
       +
                       begin try

     

       213
       213
       +
                         let data = J.get_list parse_bookmark json_array in

     

       214
       214
       +
                         let next_cursor =

     

       215
       215
       +
                           try Some (J.find json ["nextCursor"] |> J.get_string)

     

       216
       216
       +
                           with _ -> None

     

       217
       217
       +
                         in

     

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

     

       219
       219
       +
                       with e ->

     

       220
       220
       +
                         prerr_endline (Fmt.str "Error parsing bookmarks from data: %s" (Printexc.to_string e));

     

       221
       221
       +
                         { total = 0; data = []; next_cursor = None }

     

       222
       222
       +
                       end

     

       223
       223
       +
                   | None ->

     

       224
       224
       +
                       prerr_endline "No bookmarks found in alternate structure";

     

       225
       225
       +
                       { total = 0; data = []; next_cursor = None }

     

       226
       226
       +
                 end

     

       227
       227
       +
                 else begin

     

       228
       228
       +
                   match json with

     

       229
       229
       +
                   | `A _ ->

     

       230
       230
       +
                       let data =

     

       231
       231
       +
                         try J.get_list parse_bookmark json

     

       232
       232
       +
                         with e ->

     

       233
       233
       +
                           prerr_endline (Fmt.str "Error parsing root array: %s" (Printexc.to_string e));

     

       234
       234
       +
                           []

     

       235
       235
       +
                       in

     

       236
       236
       +
                       { total = List.length data; data; next_cursor = None }

     

       237
       237
       +
                   | _ ->

     

       238
       238
       +
                       prerr_endline "Not an array at root level";

     

       239
       239
       +
                       { total = 0; data = []; next_cursor = None }

     

       240
       240
       +
                 end

     

       241
       241
       +
               with e3 ->

     

       242
       242
       +
                 prerr_endline (Fmt.str "Third format parse error: %s" (Printexc.to_string e3));

     

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

     

       244
       244
       +
       

     

       245
       245
       +
       (** Fetch bookmarks from a Karakeep instance with pagination support *)

     

       246
       246
       +
       let fetch_bookmarks ~sw ~env ~api_key ?(limit=50) ?(offset=0) ?cursor ?(include_content=false) ?filter_tags base_url =

     

       247
       247
       +
         let url_base = Fmt.str "%s/api/v1/bookmarks?limit=%d&includeContent=%b"

     

       248
       248
       +
                         base_url limit include_content in

     

       249
       249
       +
       

     

       250
       250
       +
         let url =

     

       251
       251
       +
           match cursor with

     

       252
       252
       +
           | Some cursor_value -> url_base ^ "&cursor=" ^ cursor_value

     

       253
       253
       +
           | None -> url_base ^ "&offset=" ^ string_of_int offset

     

       254
       254
       +
         in

     

       255
       255
       +
       

     

       256
       256
       +
         let url = match filter_tags with

     

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

     

       258
       258
       +
               let encoded_tags =

     

       259
       259
       +
                 List.map (fun tag -> Uri.pct_encode ~component:`Query_key tag) tags

     

       260
       260
       +
               in

     

       261
       261
       +
               let tags_param = String.concat "," encoded_tags in

     

       262
       262
       +
               prerr_endline (Fmt.str "Adding tags filter: %s" tags_param);

     

       263
       263
       +
               url ^ "&tags=" ^ tags_param

     

       264
       264
       +
           | _ -> url

     

       265
       265
       +
         in

     

       266
       266
       +
       

     

       267
       267
       +
         let headers = Requests.Headers.empty

     

       268
       268
       +
           |> Requests.Headers.set "Authorization" ("Bearer " ^ api_key) in

     

       269
       269
       +
       

     

       270
       270
       +
         prerr_endline (Fmt.str "Fetching bookmarks from: %s" url);

     

       271
       271
       +
       

     

       272
       272
       +
         try

     

       273
       273
       +
           let response = Requests.One.get ~sw ~clock:env#clock ~net:env#net ~headers url in

     

       274
       274
       +
           let status_code = Requests.Response.status_code response in

     

       275
       275
       +
           if status_code = 200 then begin

     

       276
       276
       +
             let body_str = Requests.Response.body response |> Eio.Flow.read_all in

     

       277
       277
       +
             prerr_endline (Fmt.str "Received %d bytes of response data" (String.length body_str));

     

       278
       278
       +
       

     

       279
       279
       +
             try

     

       280
       280
       +
               let json = J.from_string body_str in

     

       281
       281
       +
               parse_bookmark_response json

     

       282
       282
       +
             with e ->

     

       283
       283
       +
               prerr_endline (Fmt.str "JSON parsing error: %s" (Printexc.to_string e));

     

       284
       284
       +
               prerr_endline (Fmt.str "Response body (first 200 chars): %s"

     

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

     

       286
       286
       +
               raise e

     

       287
       287
       +
           end else begin

     

       288
       288
       +
             prerr_endline (Fmt.str "HTTP error %d" status_code);

     

       289
       289
       +
             failwith (Fmt.str "HTTP error: %d" status_code)

     

       290
       290
       +
           end

     

       291
       291
       +
         with e ->

     

       292
       292
       +
           prerr_endline (Fmt.str "Network error: %s" (Printexc.to_string e));

     

       293
       293
       +
           raise e

     

       294
       294
       +
       

     

       295
       295
       +
       (** Fetch all bookmarks from a Karakeep instance using pagination *)

     

       296
       296
       +
       let fetch_all_bookmarks ~sw ~env ~api_key ?(page_size=50) ?max_pages ?filter_tags ?(include_content=false) base_url =

     

       297
       297
       +
         let rec fetch_pages page_num cursor acc _total_count =

     

       298
       298
       +
           let response =

     

       299
       299
       +
             match cursor with

     

       300
       300
       +
             | Some cursor_str -> fetch_bookmarks ~sw ~env ~api_key ~limit:page_size ~cursor:cursor_str ~include_content ?filter_tags base_url

     

       301
       301
       +
             | None -> fetch_bookmarks ~sw ~env ~api_key ~limit:page_size ~offset:(page_num * page_size) ~include_content ?filter_tags base_url

     

       302
       302
       +
           in

     

       303
       303
       +
       

     

       304
       304
       +
           let all_bookmarks = acc @ response.data in

     

       305
       305
       +
       

     

       306
       306
       +
           let more_available =

     

       307
       307
       +
             match response.next_cursor with

     

       308
       308
       +
             | Some _ -> true

     

       309
       309
       +
             | None ->

     

       310
       310
       +
                 let fetched_count = (page_num * page_size) + List.length response.data in

     

       311
       311
       +
                 fetched_count < response.total

     

       312
       312
       +
           in

     

       313
       313
       +
       

     

       314
       314
       +
           let under_max_pages = match max_pages with

     

       315
       315
       +
             | None -> true

     

       316
       316
       +
             | Some max -> page_num + 1 < max

     

       317
       317
       +
           in

     

       318
       318
       +
       

     

       319
       319
       +
           if more_available && under_max_pages then

     

       320
       320
       +
             fetch_pages (page_num + 1) response.next_cursor all_bookmarks response.total

     

       321
       321
       +
           else

     

       322
       322
       +
             all_bookmarks

     

       323
       323
       +
         in

     

       324
       324
       +
         fetch_pages 0 None [] 0

     

       325
       325
       +
       

     

       326
       326
       +
       (** Fetch detailed information for a single bookmark by ID *)

     

       327
       327
       +
       let fetch_bookmark_details ~sw ~env ~api_key base_url bookmark_id =

     

       328
       328
       +
         let url = Fmt.str "%s/api/v1/bookmarks/%s" base_url bookmark_id in

     

       329
       329
       +
       

     

       330
       330
       +
         let headers = Requests.Headers.empty

     

       331
       331
       +
           |> Requests.Headers.set "Authorization" ("Bearer " ^ api_key) in

     

       332
       332
       +
       

     

       333
       333
       +
         let response = Requests.One.get ~sw ~clock:env#clock ~net:env#net ~headers url in

     

       334
       334
       +
         let status_code = Requests.Response.status_code response in

     

       335
       335
       +
         if status_code = 200 then begin

     

       336
       336
       +
           let body_str = Requests.Response.body response |> Eio.Flow.read_all in

     

       337
       337
       +
           let json = J.from_string body_str in

     

       338
       338
       +
           parse_bookmark json

     

       339
       339
       +
         end else

     

       340
       340
       +
           failwith (Fmt.str "HTTP error: %d" status_code)

     

       341
       341
       +
       

     

       342
       342
       +
       (** Get the asset URL for a given asset ID *)

     

       343
       343
       +
       let get_asset_url base_url asset_id =

     

       344
       344
       +
         Fmt.str "%s/api/assets/%s" base_url asset_id

     

       345
       345
       +
       

     

       346
       346
       +
       (** Fetch an asset from the Karakeep server as a binary string *)

     

       347
       347
       +
       let fetch_asset ~sw ~env ~api_key base_url asset_id =

     

       348
       348
       +
         let url = get_asset_url base_url asset_id in

     

       349
       349
       +
       

     

       350
       350
       +
         let headers = Requests.Headers.empty

     

       351
       351
       +
           |> Requests.Headers.set "Authorization" ("Bearer " ^ api_key) in

     

       352
       352
       +
       

     

       353
       353
       +
         let response = Requests.One.get ~sw ~clock:env#clock ~net:env#net ~headers url in

     

       354
       354
       +
         let status_code = Requests.Response.status_code response in

     

       355
       355
       +
         if status_code = 200 then

     

       356
       356
       +
           Requests.Response.body response |> Eio.Flow.read_all

     

       357
       357
       +
         else

     

       358
       358
       +
           failwith (Fmt.str "Asset fetch error: %d" status_code)

     

       359
       359
       +
       

     

       360
       360
       +
       (** Create a new bookmark in Karakeep with optional tags *)

     

       361
       361
       +
       let create_bookmark ~sw ~env ~api_key ~url ?title ?note ?tags ?(favourited=false) ?(archived=false) base_url =

     

       362
       362
       +
         let body_obj = [

     

       363
       363
       +
           ("type", `String "link");

     

       364
       364
       +
           ("url", `String url);

     

       365
       365
       +
           ("favourited", `Bool favourited);

     

       366
       366
       +
           ("archived", `Bool archived);

     

       367
       367
       +
         ] in

     

       368
       368
       +
       

     

       369
       369
       +
         let body_obj = match title with

     

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

     

       371
       371
       +
           | None -> body_obj

     

       372
       372
       +
         in

     

       373
       373
       +
       

     

       374
       374
       +
         let body_obj = match note with

     

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

     

       376
       376
       +
           | None -> body_obj

     

       377
       377
       +
         in

     

       378
       378
       +
       

     

       379
       379
       +
         let body_json = `O body_obj in

     

       380
       380
       +
         let body_str = J.to_string body_json in

     

       381
       381
       +
       

     

       382
       382
       +
         let headers = Requests.Headers.empty

     

       383
       383
       +
           |> Requests.Headers.set "Authorization" ("Bearer " ^ api_key)

     

       384
       384
       +
           |> Requests.Headers.set "Content-Type" "application/json"

     

       385
       385
       +
         in

     

       386
       386
       +
       

     

       387
       387
       +
         let url_endpoint = Fmt.str "%s/api/v1/bookmarks" base_url in

     

       388
       388
       +
         let body = Requests.Body.of_string Requests.Mime.json body_str in

     

       389
       389
       +
         let response = Requests.One.post ~sw ~clock:env#clock ~net:env#net ~headers ~body url_endpoint in

     

       390
       390
       +
       

     

       391
       391
       +
         let status_code = Requests.Response.status_code response in

     

       392
       392
       +
         if status_code = 201 || status_code = 200 then begin

     

       393
       393
       +
           let body_str = Requests.Response.body response |> Eio.Flow.read_all in

     

       394
       394
       +
           let json = J.from_string body_str in

     

       395
       395
       +
           let bookmark = parse_bookmark json in

     

       396
       396
       +
       

     

       397
       397
       +
           match tags with

     

       398
       398
       +
           | Some tag_list when tag_list <> [] ->

     

       399
       399
       +
               let tag_objects = List.map (fun tag_name ->

     

       400
       400
       +
                 `O [("tagName", `String tag_name)]

     

       401
       401
       +
               ) tag_list in

     

       402
       402
       +
       

     

       403
       403
       +
               let tags_body = `O [("tags", `A tag_objects)] in

     

       404
       404
       +
               let tags_body_str = J.to_string tags_body in

     

       405
       405
       +
       

     

       406
       406
       +
               let tags_url = Fmt.str "%s/api/v1/bookmarks/%s/tags" base_url bookmark.id in

     

       407
       407
       +
               let tags_body = Requests.Body.of_string Requests.Mime.json tags_body_str in

     

       408
       408
       +
               let tags_response = Requests.One.post ~sw ~clock:env#clock ~net:env#net ~headers ~body:tags_body tags_url in

     

       409
       409
       +
       

     

       410
       410
       +
               let tags_status = Requests.Response.status_code tags_response in

     

       411
       411
       +
               if tags_status = 200 then

     

       412
       412
       +
                 fetch_bookmark_details ~sw ~env ~api_key base_url bookmark.id

     

       413
       413
       +
               else

     

       414
       414
       +
                 bookmark

     

       415
       415
       +
           | _ -> bookmark

     

       416
       416
       +
         end else begin

     

       417
       417
       +
           let error_body = Requests.Response.body response |> Eio.Flow.read_all in

     

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

     

       419
       419
       +
         end

     

       420
       420
       +
       

     

       421
       421
       +
       (** Convert a Karakeep bookmark to Bushel.Link.t compatible structure *)

     

       422
       422
       +
       let to_bushel_link ?base_url bookmark =

     

       423
       423
       +
         let description =

     

       424
       424
       +
           match bookmark.title with

     

       425
       425
       +
           | Some title when title <> "" -> title

     

       426
       426
       +
           | _ ->

     

       427
       427
       +
               let content_title = List.assoc_opt "title" bookmark.content in

     

       428
       428
       +
               match content_title with

     

       429
       429
       +
               | Some title when title <> "" && title <> "null" -> title

     

       430
       430
       +
               | _ -> bookmark.url

     

       431
       431
       +
         in

     

       432
       432
       +
         let date = Ptime.to_date bookmark.created_at in

     

       433
       433
       +
       

     

       434
       434
       +
         let metadata =

     

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

     

       436
       436
       +
           (List.filter_map (fun (id, asset_type) ->

     

       437
       437
       +
             match asset_type with

     

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

     

       439
       439
       +
             | _ -> None

     

       440
       440
       +
           ) bookmark.assets) @

     

       441
       441
       +
           (List.filter_map (fun (k, v) ->

     

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

     

       443
       443
       +
           ) bookmark.content)

     

       444
       444
       +
         in

     

       445
       445
       +
       

     

       446
       446
       +
         let karakeep =

     

       447
       447
       +
           match base_url with

     

       448
       448
       +
           | Some url ->

     

       449
       449
       +
               Some {

     

       450
       450
       +
                 Bushel.Link.remote_url = url;

     

       451
       451
       +
                 id = bookmark.id;

     

       452
       452
       +
                 tags = bookmark.tags;

     

       453
       453
       +
                 metadata = metadata;

     

       454
       454
       +
               }

     

       455
       455
       +
           | None -> None

     

       456
       456
       +
         in

     

       457
       457
       +
       

     

       458
       458
       +
         let bushel_slugs =

     

       459
       459
       +
           List.filter_map (fun tag ->

     

       460
       460
       +
             if String.starts_with ~prefix:"bushel:" tag then

     

       461
       461
       +
               Some (String.sub tag 7 (String.length tag - 7))

     

       462
       462
       +
             else

     

       463
       463
       +
               None

     

       464
       464
       +
           ) bookmark.tags

     

       465
       465
       +
         in

     

       466
       466
       +
       

     

       467
       467
       +
         let bushel =

     

       468
       468
       +
           if bushel_slugs = [] then None

     

       469
       469
       +
           else Some { Bushel.Link.slugs = bushel_slugs; tags = [] }

     

       470
       470
       +
         in

     

       471
       471
       +
       

     

       472
       472
       +
         { Bushel.Link.url = bookmark.url; date; description; karakeep; bushel }

+32

stack/karakeepe/karakeepe.opam

···

       1
       1
       +
       # This file is generated by dune, edit dune-project instead

     

       2
       2
       +
       opam-version: "2.0"

     

       3
       3
       +
       version: "0.1.0"

     

       4
       4
       +
       synopsis: "Karakeep API client for OCaml using Eio"

     

       5
       5
       +
       description:

     

       6
       6
       +
         "An Eio-based OCaml client library for the Karakeep bookmark management service API"

     

       7
       7
       +
       depends: [

     

       8
       8
       +
         "dune" {>= "3.0"}

     

       9
       9
       +
         "ocaml" {>= "4.14"}

     

       10
       10
       +
         "eio"

     

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

     

       12
       12
       +
         "requests"

     

       13
       13
       +
         "ezjsonm"

     

       14
       14
       +
         "fmt"

     

       15
       15
       +
         "ptime"

     

       16
       16
       +
         "uri"

     

       17
       17
       +
         "odoc" {with-doc}

     

       18
       18
       +
       ]

     

       19
       19
       +
       build: [

     

       20
       20
       +
         ["dune" "subst"] {dev}

     

       21
       21
       +
         [

     

       22
       22
       +
           "dune"

     

       23
       23
       +
           "build"

     

       24
       24
       +
           "-p"

     

       25
       25
       +
           name

     

       26
       26
       +
           "-j"

     

       27
       27
       +
           jobs

     

       28
       28
       +
           "@install"

     

       29
       29
       +
           "@runtest" {with-test}

     

       30
       30
       +
           "@doc" {with-doc}

     

       31
       31
       +
         ]

     

       32
       32
       +
       ]

+39

stack/peertubee/README.md

···

       1
       1
       +
       # PeerTubee - Eio-based PeerTube API Client

     

       2
       2
       +
       

     

       3
       3
       +
       This is a port of the PeerTube library from Lwt/Cohttp to Eio/Requests.

     

       4
       4
       +
       

     

       5
       5
       +
       ## Changes from Original

     

       6
       6
       +
       

     

       7
       7
       +
       - **Removed** `open Lwt.Infix`

     

       8
       8
       +
       - **Replaced** all `Lwt.t` return types with direct return types (direct-style)

     

       9
       9
       +
       - **Added** `~sw:Eio.Switch.t` and `~env:<...>` parameters to all public functions

     

       10
       10
       +
       - **Replaced** `Cohttp_lwt_unix.Client.get` with `Requests.One.get`

     

       11
       11
       +
       - **Replaced** `Cohttp_lwt.Body.to_string body >>= fun s ->` with `let s = Requests.Response.body response |> Eio.Flow.read_all in`

     

       12
       12
       +
       - **Replaced** `>>=` (Lwt.bind) with direct let bindings

     

       13
       13
       +
       - **Replaced** `Lwt.return` with direct values

     

       14
       14
       +
       - **Replaced** `Lwt.return_ok`/`Lwt.return_error` with `Ok`/`Error`

     

       15
       15
       +
       - **Replaced** `open_out_bin` with `Eio.Path.save` for file writing

     

       16
       16
       +
       - **Used** `Requests.One.create` with `Eio.Stdenv.clock` and `Eio.Stdenv.net`

     

       17
       17
       +
       

     

       18
       18
       +
       ## Statistics

     

       19
       19
       +
       

     

       20
       20
       +
       - Original: 191 lines

     

       21
       21
       +
       - Ported: 188 lines

     

       22
       22
       +
       - Functions: 8 public functions

     

       23
       23
       +
       - All JSON parsing logic preserved

     

       24
       24
       +
       - All type definitions preserved

     

       25
       25
       +
       

     

       26
       26
       +
       ## Files Created

     

       27
       27
       +
       

     

       28
       28
       +
       - `/workspace/stack/bushel/peertubee/peertubee.ml` - Implementation (188 lines)

     

       29
       29
       +
       - `/workspace/stack/bushel/peertubee/peertubee.mli` - Interface (69 lines)

     

       30
       30
       +
       - `/workspace/stack/bushel/peertubee/dune` - Build configuration

     

       31
       31
       +
       - `/workspace/stack/bushel/peertubee.opam` - Package metadata

     

       32
       32
       +
       

     

       33
       33
       +
       ## Dependencies

     

       34
       34
       +
       

     

       35
       35
       +
       - ezjsonm - JSON parsing

     

       36
       36
       +
       - eio + eio.core - Effects-based concurrency

     

       37
       37
       +
       - requests - HTTP client

     

       38
       38
       +
       - ptime - Time handling

     

       39
       39
       +
       - fmt - Formatted output

stack/peertubee/dune

···

       1
       1
       +
       (library

     

       2
       2
       +
        (name peertubee)

     

       3
       3
       +
        (public_name peertubee)

     

       4
       4
       +
        (libraries ezjsonm eio eio.core requests ptime fmt))

+18

stack/peertubee/dune-project

···

       1
       1
       +
       (lang dune 3.0)

     

       2
       2
       +
       (name peertubee)

     

       3
       3
       +
       (version 0.1.0)

     

       4
       4
       +
       

     

       5
       5
       +
       (generate_opam_files true)

     

       6
       6
       +
       

     

       7
       7
       +
       (package

     

       8
       8
       +
        (name peertubee)

     

       9
       9
       +
        (synopsis "PeerTube API client for OCaml using Eio")

     

       10
       10
       +
        (description "An Eio-based OCaml client library for PeerTube video platform instances")

     

       11
       11
       +
        (depends

     

       12
       12
       +
         (ocaml (>= 4.14))

     

       13
       13
       +
         eio

     

       14
       14
       +
         (eio_main (>= 1.0))

     

       15
       15
       +
         requests

     

       16
       16
       +
         ezjsonm

     

       17
       17
       +
         fmt

     

       18
       18
       +
         ptime))

+31

stack/peertubee/peertubee.opam

···

       1
       1
       +
       # This file is generated by dune, edit dune-project instead

     

       2
       2
       +
       opam-version: "2.0"

     

       3
       3
       +
       version: "0.1.0"

     

       4
       4
       +
       synopsis: "PeerTube API client for OCaml using Eio"

     

       5
       5
       +
       description:

     

       6
       6
       +
         "An Eio-based OCaml client library for PeerTube video platform instances"

     

       7
       7
       +
       depends: [

     

       8
       8
       +
         "dune" {>= "3.0"}

     

       9
       9
       +
         "ocaml" {>= "4.14"}

     

       10
       10
       +
         "eio"

     

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

     

       12
       12
       +
         "requests"

     

       13
       13
       +
         "ezjsonm"

     

       14
       14
       +
         "fmt"

     

       15
       15
       +
         "ptime"

     

       16
       16
       +
         "odoc" {with-doc}

     

       17
       17
       +
       ]

     

       18
       18
       +
       build: [

     

       19
       19
       +
         ["dune" "subst"] {dev}

     

       20
       20
       +
         [

     

       21
       21
       +
           "dune"

     

       22
       22
       +
           "build"

     

       23
       23
       +
           "-p"

     

       24
       24
       +
           name

     

       25
       25
       +
           "-j"

     

       26
       26
       +
           jobs

     

       27
       27
       +
           "@install"

     

       28
       28
       +
           "@runtest" {with-test}

     

       29
       29
       +
           "@doc" {with-doc}

     

       30
       30
       +
         ]

     

       31
       31
       +
       ]

+5 -3

stack/requests/bin/ocurl.ml

···

       229
       229
        
           ~follow_redirects ~max_redirects ?timeout:timeout_obj env in

     

       230
       230
        
       

     

       231
       231
        
         (* Set authentication if provided *)

     

       232
       232
       -
         (match auth with

     

       232
       232
       +
         let req = match auth with

     

       233
       233
        
          | Some auth_str ->

     

       234
       234
        
              (match parse_auth auth_str with

     

       235
       235
        
               | Some (user, pass) ->

     

       236
       236
        
                   Requests.set_auth req

     

       237
       237
        
                     (Requests.Auth.basic ~username:user ~password:pass)

     

       238
       238
        
               | None ->

     

       239
       239
       -
                   Logs.warn (fun m -> m "Invalid auth format, ignoring"))

     

       240
       240
       -
          | None -> ());

     

       239
       239
       +
                   Logs.warn (fun m -> m "Invalid auth format, ignoring");

     

       240
       240
       +
                   req)

     

       241
       241
       +
          | None -> req

     

       242
       242
       +
         in

     

       241
       243
        
       

     

       242
       244
        
         (* Build headers from command line *)

     

       243
       245
        
         let cmd_headers = List.fold_left (fun hdrs header_str ->

+112 -167

stack/requests/lib/one.ml

···

       1
       1
        
       let src = Logs.Src.create "requests.one" ~doc:"One-shot HTTP Requests"

     

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

     

       3
       3
        
       

     

       4
       4
       -
       type ('clock,'net) t = {

     

       5
       5
       -
         clock : 'clock;

     

       6
       6
       -
         net : 'net;

     

       7
       7
       -
         default_headers : Headers.t;

     

       8
       8
       -
         timeout : Timeout.t;

     

       9
       9
       -
         max_retries : int;

     

       10
       10
       -
         retry_backoff : float;

     

       11
       11
       -
         verify_tls : bool;

     

       12
       12
       -
         tls_config : Tls.Config.client option;

     

       13
       13
       -
         http_pool : ('clock, 'net) Conpool.t;  (* For HTTP connections *)

     

       14
       14
       -
         https_pool : ('clock, 'net) Conpool.t; (* For HTTPS connections *)

     

       15
       15
       -
       }

     

       4
       4
       +
       (* Helper to create TCP connection to host:port *)

     

       5
       5
       +
       let connect_tcp ~sw ~net ~host ~port =

     

       6
       6
       +
         Log.debug (fun m -> m "Connecting to %s:%d" host port);

     

       7
       7
       +
         (* Resolve hostname to IP address *)

     

       8
       8
       +
         let addrs = Eio.Net.getaddrinfo_stream net host ~service:(string_of_int port) in

     

       9
       9
       +
         match addrs with

     

       10
       10
       +
         | addr :: _ ->

     

       11
       11
       +
             Log.debug (fun m -> m "Resolved %s, connecting..." host);

     

       12
       12
       +
             Eio.Net.connect ~sw net addr

     

       13
       13
       +
         | [] ->

     

       14
       14
       +
             let msg = Printf.sprintf "Failed to resolve hostname: %s" host in

     

       15
       15
       +
             Log.err (fun m -> m "%s" msg);

     

       16
       16
       +
             failwith msg

     

       16
       17
        
       

     

       17
       17
       -
       let create

     

       18
       18
       -
           ~sw

     

       19
       19
       -
           ?(default_headers = Headers.empty)

     

       20
       20
       -
           ?(timeout = Timeout.default)

     

       21
       21
       -
           ?(max_retries = 3)

     

       22
       22
       -
           ?(retry_backoff = 2.0)

     

       23
       23
       -
           ?(verify_tls = true)

     

       24
       24
       -
           ?tls_config

     

       25
       25
       -
           ?(max_connections_per_host = 10)

     

       26
       26
       -
           ?(connection_idle_timeout = 60.0)

     

       27
       27
       -
           ?(connection_lifetime = 300.0)

     

       28
       28
       -
           ~clock

     

       29
       29
       -
           ~net

     

       30
       30
       -
           () =

     

       31
       31
       -
         (* Create default TLS config if verify_tls is true and no custom config provided *)

     

       32
       32
       -
         let tls_config =

     

       33
       33
       -
           match tls_config, verify_tls with

     

       34
       34
       -
           | Some config, _ -> Some config

     

       18
       18
       +
       (* Helper to wrap connection with TLS if needed *)

     

       19
       19
       +
       let wrap_tls flow ~host ~verify_tls ~tls_config =

     

       20
       20
       +
         Log.debug (fun m -> m "Wrapping connection with TLS for %s (verify=%b)" host verify_tls);

     

       21
       21
       +
       

     

       22
       22
       +
         (* Get or create TLS config *)

     

       23
       23
       +
         let tls_cfg = match tls_config, verify_tls with

     

       24
       24
       +
           | Some cfg, _ -> cfg

     

       35
       25
        
           | None, true ->

     

       36
       26
        
               (* Use CA certificates for verification *)

     

       37
       27
        
               (match Ca_certs.authenticator () with

     

       38
       28
        
                | Ok authenticator ->

     

       39
       29
        
                    (match Tls.Config.client ~authenticator () with

     

       40
       40
       -
                     | Ok cfg -> Some cfg

     

       30
       30
       +
                     | Ok cfg -> cfg

     

       41
       31
        
                     | Error (`Msg msg) ->

     

       42
       42
       -
                         Log.warn (fun m -> m "Failed to create TLS config: %s" msg);

     

       43
       43
       -
                         None)

     

       32
       32
       +
                         Log.err (fun m -> m "Failed to create TLS config: %s" msg);

     

       33
       33
       +
                         failwith ("TLS config error: " ^ msg))

     

       44
       34
        
                | Error (`Msg msg) ->

     

       45
       45
       -
                    Log.warn (fun m -> m "Failed to load CA certificates: %s" msg);

     

       46
       46
       -
                    None)

     

       47
       47
       -
           | None, false -> None

     

       35
       35
       +
                    Log.err (fun m -> m "Failed to load CA certificates: %s" msg);

     

       36
       36
       +
                    failwith ("CA certificates error: " ^ msg))

     

       37
       37
       +
           | None, false ->

     

       38
       38
       +
               (* No verification *)

     

       39
       39
       +
               match Tls.Config.client ~authenticator:(fun ?ip:_ ~host:_ _ -> Ok None) () with

     

       40
       40
       +
               | Ok cfg -> cfg

     

       41
       41
       +
               | Error (`Msg msg) -> failwith ("TLS config error: " ^ msg)

     

       48
       42
        
         in

     

       49
       43
        
       

     

       50
       50
       -
         (* Create connection pools - one for HTTP, one for HTTPS *)

     

       51
       51
       -
         let pool_config = Conpool.Config.make

     

       52
       52
       -
           ~max_connections_per_endpoint:max_connections_per_host

     

       53
       53
       -
           ~max_idle_time:connection_idle_timeout

     

       54
       54
       -
           ~max_connection_lifetime:connection_lifetime

     

       55
       55
       -
           ()

     

       44
       44
       +
         (* Get domain name for SNI *)

     

       45
       45
       +
         let domain = match Domain_name.of_string host with

     

       46
       46
       +
           | Ok dn -> (match Domain_name.host dn with

     

       47
       47
       +
               | Ok d -> d

     

       48
       48
       +
               | Error (`Msg msg) ->

     

       49
       49
       +
                   Log.err (fun m -> m "Invalid hostname for TLS: %s (%s)" host msg);

     

       50
       50
       +
                   failwith ("Invalid hostname: " ^ msg))

     

       51
       51
       +
           | Error (`Msg msg) ->

     

       52
       52
       +
               Log.err (fun m -> m "Invalid hostname for TLS: %s (%s)" host msg);

     

       53
       53
       +
               failwith ("Invalid hostname: " ^ msg)

     

       56
       54
        
         in

     

       57
       55
        
       

     

       58
       58
       -
         (* HTTP pool - plain TCP connections *)

     

       59
       59
       -
         let http_pool = Conpool.create

     

       60
       60
       -
           ~sw

     

       61
       61
       -
           ~net

     

       62
       62
       -
           ~clock

     

       63
       63
       -
           ~config:pool_config

     

       64
       64
       -
           ()

     

       65
       65
       -
         in

     

       56
       56
       +
         (Tls_eio.client_of_flow ~host:domain tls_cfg flow :> [`Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t)

     

       66
       57
        
       

     

       67
       67
       -
         (* HTTPS pool - TLS-wrapped connections *)

     

       68
       68
       -
         let https_tls_config = Option.map (fun cfg ->

     

       69
       69
       -
           Conpool.Tls_config.make ~config:cfg ()

     

       70
       70
       -
         ) tls_config in

     

       58
       58
       +
       (* Parse URL and connect directly (no pooling) *)

     

       59
       59
       +
       let connect_to_url ~sw ~clock ~net ~url ~timeout ~verify_tls ~tls_config =

     

       60
       60
       +
         let uri = Uri.of_string url in

     

       71
       61
        
       

     

       72
       72
       -
         let https_pool = Conpool.create

     

       73
       73
       -
           ~sw

     

       74
       74
       -
           ~net

     

       75
       75
       -
           ~clock

     

       76
       76
       -
           ?tls:https_tls_config

     

       77
       77
       -
           ~config:pool_config

     

       78
       78
       -
           ()

     

       62
       62
       +
         (* Extract host and port *)

     

       63
       63
       +
         let host = match Uri.host uri with

     

       64
       64
       +
           | Some h -> h

     

       65
       65
       +
           | None -> failwith ("URL must contain a host: " ^ url)

     

       79
       66
        
         in

     

       80
       67
        
       

     

       81
       81
       -
         Log.info (fun m -> m "Created HTTP client with connection pools (max_per_host=%d, TLS=%b)"

     

       82
       82
       -
           max_connections_per_host (Option.is_some https_tls_config));

     

       68
       68
       +
         let is_https = Uri.scheme uri = Some "https" in

     

       69
       69
       +
         let default_port = if is_https then 443 else 80 in

     

       70
       70
       +
         let port = Option.value (Uri.port uri) ~default:default_port in

     

       83
       71
        
       

     

       84
       84
       -
         {

     

       85
       85
       -
           clock;

     

       86
       86
       -
           net;

     

       87
       87
       -
           default_headers;

     

       88
       88
       -
           timeout;

     

       89
       89
       -
           max_retries;

     

       90
       90
       -
           retry_backoff;

     

       91
       91
       -
           verify_tls;

     

       92
       92
       -
           tls_config;

     

       93
       93
       -
           http_pool;

     

       94
       94
       -
           https_pool;

     

       95
       95
       -
         }

     

       72
       72
       +
         (* Apply connection timeout if specified *)

     

       73
       73
       +
         let connect_fn () =

     

       74
       74
       +
           let tcp_flow = connect_tcp ~sw ~net ~host ~port in

     

       75
       75
       +
           if is_https then

     

       76
       76
       +
             wrap_tls tcp_flow ~host ~verify_tls ~tls_config

     

       77
       77
       +
           else

     

       78
       78
       +
             (tcp_flow :> [`Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t)

     

       79
       79
       +
         in

     

       96
       80
        
       

     

       97
       97
       -
       let default ~sw ~clock ~net =

     

       98
       98
       -
         create ~sw ~clock ~net ()

     

       81
       81
       +
         match timeout with

     

       82
       82
       +
         | Some t ->

     

       83
       83
       +
             let timeout_seconds = Timeout.total t in

     

       84
       84
       +
             (match timeout_seconds with

     

       85
       85
       +
              | Some seconds ->

     

       86
       86
       +
                  Log.debug (fun m -> m "Setting connection timeout: %.2f seconds" seconds);

     

       87
       87
       +
                  Eio.Time.with_timeout_exn clock seconds connect_fn

     

       88
       88
       +
              | None -> connect_fn ())

     

       89
       89
       +
         | None -> connect_fn ()

     

       99
       90
        
       

     

       100
       100
       -
       (* Accessors *)

     

       101
       101
       -
       let clock t = t.clock

     

       102
       102
       -
       let net t = t.net

     

       103
       103
       -
       let default_headers t = t.default_headers

     

       104
       104
       -
       let timeout t = t.timeout

     

       105
       105
       -
       let max_retries t = t.max_retries

     

       106
       106
       -
       let retry_backoff t = t.retry_backoff

     

       107
       107
       -
       let verify_tls t = t.verify_tls

     

       108
       108
       -
       let tls_config t = t.tls_config

     

       91
       91
       +
       (* Main request implementation - completely stateless *)

     

       92
       92
       +
       let request ~sw ~clock ~net ?headers ?body ?auth ?timeout

     

       93
       93
       +
           ?(follow_redirects = true) ?(max_redirects = 10)

     

       94
       94
       +
           ?(verify_tls = true) ?tls_config ~method_ url =

     

       109
       95
        
       

     

       110
       110
       -
       (* HTTP Request Methods *)

     

       111
       111
       -
       

     

       112
       112
       -
       (* Helper to get client or use default *)

     

       113
       113
       -
       let get_client client =

     

       114
       114
       -
         match client with

     

       115
       115
       -
         | Some c -> c

     

       116
       116
       -
         | None -> failwith "No client provided"

     

       117
       117
       -
       

     

       118
       118
       -
       (* Main request implementation with connection pooling *)

     

       119
       119
       -
       let request ~sw ?client ?headers ?body ?auth ?timeout ?follow_redirects

     

       120
       120
       -
           ?max_redirects ~method_ url =

     

       121
       121
       -
         let client = get_client client in

     

       122
       96
        
         let start_time = Unix.gettimeofday () in

     

       123
       123
       -
       

     

       124
       97
        
         let method_str = Method.to_string method_ in

     

       125
       98
        
         Log.debug (fun m -> m "[One] Executing %s request to %s" method_str url);

     

       126
       99
        
       

     

       127
       100
        
         (* Prepare headers *)

     

       128
       128
       -
         let headers = match headers with

     

       129
       129
       -
           | Some h -> h

     

       130
       130
       -
           | None -> default_headers client

     

       131
       131
       -
         in

     

       101
       101
       +
         let headers = Option.value headers ~default:Headers.empty in

     

       132
       102
        
       

     

       133
       103
        
         (* Apply auth *)

     

       134
       104
        
         let headers = match auth with

     
···

       152
       122
        
           | Some b -> Body.Private.to_string b

     

       153
       123
        
         in

     

       154
       124
        
       

     

       155
       155
       -
         (* Execute request with pooled connection *)

     

       125
       125
       +
         (* Execute request with redirects *)

     

       156
       126
        
         let rec make_with_redirects url_to_fetch redirects_left =

     

       157
       127
        
           let uri_to_fetch = Uri.of_string url_to_fetch in

     

       158
       128
        
       

     

       159
       159
       -
           (* Parse the redirect URL to get correct host and port *)

     

       160
       160
       -
           let redirect_host = match Uri.host uri_to_fetch with

     

       161
       161
       -
             | Some h -> h

     

       162
       162
       -
             | None -> failwith "Redirect URL must contain a host"

     

       163
       163
       -
           in

     

       164
       164
       -
           let redirect_port = match Uri.scheme uri_to_fetch, Uri.port uri_to_fetch with

     

       165
       165
       -
             | Some "https", None -> 443

     

       166
       166
       -
             | Some "https", Some p -> p

     

       167
       167
       -
             | Some "http", None -> 80

     

       168
       168
       -
             | Some "http", Some p -> p

     

       169
       169
       -
             | _, Some p -> p

     

       170
       170
       -
             | _ -> 80

     

       171
       171
       -
           in

     

       129
       129
       +
           (* Connect to URL (opens new TCP connection) *)

     

       130
       130
       +
           let flow = connect_to_url ~sw ~clock ~net ~url:url_to_fetch

     

       131
       131
       +
                        ~timeout ~verify_tls ~tls_config in

     

       172
       132
        
       

     

       173
       173
       -
           (* Create endpoint for this specific URL *)

     

       174
       174
       -
           let endpoint = Conpool.Endpoint.make ~host:redirect_host ~port:redirect_port in

     

       175
       175
       -
       

     

       176
       176
       -
           (* Determine if we need TLS based on this URL's scheme *)

     

       177
       177
       -
           let is_https = match Uri.scheme uri_to_fetch with

     

       178
       178
       -
             | Some "https" -> true

     

       179
       179
       -
             | _ -> false

     

       180
       180
       -
           in

     

       181
       181
       -
       

     

       182
       182
       -
           (* Choose the appropriate connection pool for this URL *)

     

       183
       183
       -
           let pool = if is_https then client.https_pool else client.http_pool in

     

       184
       184
       -
       

     

       185
       185
       -
           let make_request_fn () =

     

       186
       186
       -
             Conpool.with_connection pool endpoint (fun flow ->

     

       187
       187
       -
               (* Flow is already TLS-wrapped if from https_pool, plain TCP if from http_pool *)

     

       188
       188
       -
               (* Use our low-level HTTP client *)

     

       189
       189
       -
               Http_client.make_request ~method_:method_str ~uri:uri_to_fetch ~headers ~body_str:request_body_str flow

     

       190
       190
       -
             )

     

       191
       191
       -
           in

     

       192
       192
       -
       

     

       193
       193
       -
           (* Apply timeout if specified *)

     

       133
       133
       +
           (* Make HTTP request using low-level client *)

     

       194
       134
        
           let status, resp_headers, response_body_str =

     

       195
       195
       -
             match timeout with

     

       196
       196
       -
             | Some t ->

     

       197
       197
       -
                 let timeout_seconds = Timeout.total t in

     

       198
       198
       -
                 (match timeout_seconds with

     

       199
       199
       -
                  | Some seconds ->

     

       200
       200
       -
                      Log.debug (fun m -> m "Setting timeout: %.2f seconds" seconds);

     

       201
       201
       -
                      Eio.Time.with_timeout_exn (clock client) seconds make_request_fn

     

       202
       202
       -
                  | None -> make_request_fn ())

     

       203
       203
       -
             | None -> make_request_fn ()

     

       135
       135
       +
             Http_client.make_request ~method_:method_str ~uri:uri_to_fetch

     

       136
       136
       +
               ~headers ~body_str:request_body_str flow

     

       204
       137
        
           in

     

       205
       138
        
       

     

       206
       139
        
           Log.info (fun m -> m "Received response: status=%d" status);

     

       207
       140
        
       

     

       208
       141
        
           (* Handle redirects if enabled *)

     

       209
       209
       -
           let follow_redirects = Option.value follow_redirects ~default:true in

     

       210
       142
        
           if follow_redirects && (status >= 300 && status < 400) then begin

     

       211
       143
        
             if redirects_left <= 0 then begin

     

       212
       212
       -
               let max_redirects = Option.value max_redirects ~default:10 in

     

       213
       144
        
               Log.err (fun m -> m "Too many redirects (%d) for %s" max_redirects url);

     

       214
       145
        
               raise (Error.TooManyRedirects { url; count = max_redirects; max = max_redirects })

     

       215
       146
        
             end;

     
···

       225
       156
        
             (status, resp_headers, response_body_str, url_to_fetch)

     

       226
       157
        
         in

     

       227
       158
        
       

     

       228
       228
       -
         let max_redirects = Option.value max_redirects ~default:10 in

     

       229
       159
        
         let final_status, final_headers, final_body_str, final_url =

     

       230
       160
        
           make_with_redirects url max_redirects

     

       231
       161
        
         in

     
···

       245
       175
        
           ~elapsed

     

       246
       176
        
       

     

       247
       177
        
       (* Convenience methods *)

     

       248
       248
       -
       let get ~sw ?client ?headers ?auth ?timeout ?follow_redirects ?max_redirects url =

     

       249
       249
       -
         request ~sw ?client ?headers ?auth ?timeout ?follow_redirects ?max_redirects

     

       178
       178
       +
       let get ~sw ~clock ~net ?headers ?auth ?timeout

     

       179
       179
       +
           ?follow_redirects ?max_redirects ?verify_tls ?tls_config url =

     

       180
       180
       +
         request ~sw ~clock ~net ?headers ?auth ?timeout

     

       181
       181
       +
           ?follow_redirects ?max_redirects ?verify_tls ?tls_config

     

       250
       182
        
           ~method_:`GET url

     

       251
       183
        
       

     

       252
       252
       -
       let post ~sw ?client ?headers ?body ?auth ?timeout url =

     

       253
       253
       -
         request ~sw ?client ?headers ?body ?auth ?timeout ~method_:`POST url

     

       184
       184
       +
       let post ~sw ~clock ~net ?headers ?body ?auth ?timeout

     

       185
       185
       +
           ?verify_tls ?tls_config url =

     

       186
       186
       +
         request ~sw ~clock ~net ?headers ?body ?auth ?timeout

     

       187
       187
       +
           ?verify_tls ?tls_config ~method_:`POST url

     

       254
       188
        
       

     

       255
       255
       -
       let put ~sw ?client ?headers ?body ?auth ?timeout url =

     

       256
       256
       -
         request ~sw ?client ?headers ?body ?auth ?timeout ~method_:`PUT url

     

       189
       189
       +
       let put ~sw ~clock ~net ?headers ?body ?auth ?timeout

     

       190
       190
       +
           ?verify_tls ?tls_config url =

     

       191
       191
       +
         request ~sw ~clock ~net ?headers ?body ?auth ?timeout

     

       192
       192
       +
           ?verify_tls ?tls_config ~method_:`PUT url

     

       257
       193
        
       

     

       258
       258
       -
       let delete ~sw ?client ?headers ?auth ?timeout url =

     

       259
       259
       -
         request ~sw ?client ?headers ?auth ?timeout ~method_:`DELETE url

     

       194
       194
       +
       let delete ~sw ~clock ~net ?headers ?auth ?timeout

     

       195
       195
       +
           ?verify_tls ?tls_config url =

     

       196
       196
       +
         request ~sw ~clock ~net ?headers ?auth ?timeout

     

       197
       197
       +
           ?verify_tls ?tls_config ~method_:`DELETE url

     

       260
       198
        
       

     

       261
       261
       -
       let head ~sw ?client ?headers ?auth ?timeout url =

     

       262
       262
       -
         request ~sw ?client ?headers ?auth ?timeout ~method_:`HEAD url

     

       199
       199
       +
       let head ~sw ~clock ~net ?headers ?auth ?timeout

     

       200
       200
       +
           ?verify_tls ?tls_config url =

     

       201
       201
       +
         request ~sw ~clock ~net ?headers ?auth ?timeout

     

       202
       202
       +
           ?verify_tls ?tls_config ~method_:`HEAD url

     

       263
       203
        
       

     

       264
       264
       -
       let patch ~sw ?client ?headers ?body ?auth ?timeout url =

     

       265
       265
       -
         request ~sw ?client ?headers ?body ?auth ?timeout ~method_:`PATCH url

     

       204
       204
       +
       let patch ~sw ~clock ~net ?headers ?body ?auth ?timeout

     

       205
       205
       +
           ?verify_tls ?tls_config url =

     

       206
       206
       +
         request ~sw ~clock ~net ?headers ?body ?auth ?timeout

     

       207
       207
       +
           ?verify_tls ?tls_config ~method_:`PATCH url

     

       266
       208
        
       

     

       267
       267
       -
       let upload ~sw ?client ?headers ?auth ?timeout ?method_ ?mime ?length

     

       268
       268
       -
           ?on_progress ~source url =

     

       209
       209
       +
       let upload ~sw ~clock ~net ?headers ?auth ?timeout ?method_ ?mime ?length

     

       210
       210
       +
           ?on_progress ?verify_tls ?tls_config ~source url =

     

       269
       211
        
         let method_ = Option.value method_ ~default:`POST in

     

       270
       212
        
         let mime = Option.value mime ~default:Mime.octet_stream in

     

       271
       213
        
       

     
···

       281
       223
        
         in

     

       282
       224
        
       

     

       283
       225
        
         let body = Body.of_stream ?length mime tracked_source in

     

       284
       284
       -
         request ~sw ?client ?headers ~body ?auth ?timeout ~method_ url

     

       226
       226
       +
         request ~sw ~clock ~net ?headers ~body ?auth ?timeout

     

       227
       227
       +
           ?verify_tls ?tls_config ~method_ url

     

       285
       228
        
       

     

       286
       286
       -
       let download ~sw ?client ?headers ?auth ?timeout ?on_progress url ~sink =

     

       287
       287
       -
         let response = get ~sw ?client ?headers ?auth ?timeout url in

     

       229
       229
       +
       let download ~sw ~clock ~net ?headers ?auth ?timeout ?on_progress

     

       230
       230
       +
           ?verify_tls ?tls_config url ~sink =

     

       231
       231
       +
         let response = get ~sw ~clock ~net ?headers ?auth ?timeout

     

       232
       232
       +
                          ?verify_tls ?tls_config url in

     

       288
       233
        
       

     

       289
       234
        
         try

     

       290
       235
        
           (* Get content length for progress tracking *)

+80 -94

stack/requests/lib/one.mli

···

       1
       1
        
       (** One-shot HTTP client for stateless requests

     

       2
       2
        
       

     

       3
       3
        
           The One module provides a stateless HTTP client for single requests without

     

       4
       4
       -
           session state like cookies or persistent configuration. For stateful requests

     

       5
       5
       -
           with automatic cookie handling and persistent configuration, use the main

     

       6
       6
       -
           {!Requests} module instead.

     

       4
       4
       +
           session state like cookies, connection pooling, or persistent configuration.

     

       5
       5
       +
           Each request opens a new connection that is closed after use.

     

       6
       6
       +
       

     

       7
       7
       +
           For stateful requests with automatic cookie handling, connection pooling,

     

       8
       8
       +
           and persistent configuration, use the main {!Requests} module instead.

     

       7
       9
        
       

     

       8
       10
        
           {2 Examples}

     

       9
       11
        
       

     
···

       12
       14
        
       

     

       13
       15
        
             let () = run @@ fun env ->

     

       14
       16
        
             Switch.run @@ fun sw ->

     

       15
       15
       -
       

     

       16
       16
       -
             (* Create a one-shot client *)

     

       17
       17
       -
             let client = One.create ~clock:env#clock ~net:env#net () in

     

       18
       17
        
       

     

       19
       18
        
             (* Simple GET request *)

     

       20
       20
       -
             let response = One.get ~sw ~client "https://example.com" in

     

       19
       19
       +
             let response = One.get ~sw

     

       20
       20
       +
               ~clock:env#clock ~net:env#net

     

       21
       21
       +
               "https://example.com" in

     

       21
       22
        
             Printf.printf "Status: %d\n" (Response.status_code response);

     

       22
       23
        
             Response.close response;

     

       23
       24
        
       

     

       24
       25
        
             (* POST with JSON body *)

     

       25
       25
       -
             let response = One.post ~sw ~client

     

       26
       26
       +
             let response = One.post ~sw

     

       27
       27
       +
               ~clock:env#clock ~net:env#net

     

       26
       28
        
               ~body:(Body.json {|{"key": "value"}|})

     

       27
       29
        
               ~headers:(Headers.empty |> Headers.content_type Mime.json)

     

       28
       30
        
               "https://api.example.com/data" in

     

       29
       31
        
             Response.close response;

     

       30
       32
        
       

     

       31
       33
        
             (* Download file with streaming *)

     

       32
       32
       -
             One.download ~sw ~client

     

       34
       34
       +
             One.download ~sw

     

       35
       35
       +
               ~clock:env#clock ~net:env#net

     

       33
       36
        
               "https://example.com/large-file.zip"

     

       34
       37
        
               ~sink:(Eio.Path.(fs / "download.zip" |> sink))

     

       35
       38
        
           ]}

     
···

       38
       41
        
       (** Log source for one-shot request operations *)

     

       39
       42
        
       val src : Logs.Src.t

     

       40
       43
        
       

     

       41
       41
       -
       type ('a,'b) t

     

       42
       42
       -
       (** One-shot client configuration with clock and network types.

     

       43
       43
       -
           The type parameters track the Eio environment capabilities. *)

     

       44
       44
       -
       

     

       45
       45
       -
       (** {1 Creation} *)

     

       46
       46
       -
       

     

       47
       47
       -
       val create :

     

       48
       48
       -
         sw:Eio.Switch.t ->

     

       49
       49
       -
         ?default_headers:Headers.t ->

     

       50
       50
       -
         ?timeout:Timeout.t ->

     

       51
       51
       -
         ?max_retries:int ->

     

       52
       52
       -
         ?retry_backoff:float ->

     

       53
       53
       -
         ?verify_tls:bool ->

     

       54
       54
       -
         ?tls_config:Tls.Config.client ->

     

       55
       55
       -
         ?max_connections_per_host:int ->

     

       56
       56
       -
         ?connection_idle_timeout:float ->

     

       57
       57
       -
         ?connection_lifetime:float ->

     

       58
       58
       -
         clock:'a Eio.Time.clock ->

     

       59
       59
       -
         net:'b Eio.Net.t ->

     

       60
       60
       -
         unit -> ('a Eio.Time.clock, 'b Eio.Net.t) t

     

       61
       61
       -
       (** [create ~sw ?default_headers ?timeout ?max_retries ?retry_backoff ?verify_tls ?tls_config ~clock ~net ()]

     

       62
       62
       -
           creates a new HTTP client with connection pooling.

     

       63
       63
       -
       

     

       64
       64
       -
           @param sw Switch for resource management (client bound to this switch)

     

       65
       65
       -
           @param default_headers Headers to include in every request (default: empty)

     

       66
       66
       -
           @param timeout Default timeout configuration (default: 30s connect, 60s read)

     

       67
       67
       -
           @param max_retries Maximum number of retries for failed requests (default: 3)

     

       68
       68
       -
           @param retry_backoff Exponential backoff factor for retries (default: 2.0)

     

       69
       69
       -
           @param verify_tls Whether to verify TLS certificates (default: true)

     

       70
       70
       -
           @param tls_config Custom TLS configuration (default: uses system CA certificates)

     

       71
       71
       -
           @param max_connections_per_host Maximum pooled connections per host:port (default: 10)

     

       72
       72
       -
           @param connection_idle_timeout Max idle time before closing pooled connection (default: 60s)

     

       73
       73
       -
           @param connection_lifetime Max lifetime of any pooled connection (default: 300s)

     

       74
       74
       -
           @param clock Eio clock for timeouts and scheduling

     

       75
       75
       -
           @param net Eio network capability for making connections

     

       76
       76
       -
       *)

     

       77
       77
       -
       

     

       78
       78
       -
       val default : sw:Eio.Switch.t -> clock:'a Eio.Time.clock -> net:'b Eio.Net.t -> ('a Eio.Time.clock, 'b Eio.Net.t) t

     

       79
       79
       -
       (** [default ~sw ~clock ~net] creates a client with default configuration.

     

       80
       80
       -
           Equivalent to [create ~sw ~clock ~net ()]. *)

     

       81
       81
       -
       

     

       82
       82
       -
       (** {1 Configuration Access} *)

     

       83
       83
       -
       

     

       84
       84
       -
       val clock : ('a,'b) t -> 'a

     

       85
       85
       -
       (** [clock client] returns the clock capability. *)

     

       86
       86
       -
       

     

       87
       87
       -
       val net : ('a,'b) t -> 'b

     

       88
       88
       -
       (** [net client] returns the network capability. *)

     

       89
       89
       -
       

     

       90
       90
       -
       val default_headers : ('a,'b) t -> Headers.t

     

       91
       91
       -
       (** [default_headers client] returns the default headers. *)

     

       92
       92
       -
       

     

       93
       93
       -
       val timeout : ('a,'b) t -> Timeout.t

     

       94
       94
       -
       (** [timeout client] returns the timeout configuration. *)

     

       95
       95
       -
       

     

       96
       96
       -
       val max_retries : ('a,'b) t -> int

     

       97
       97
       -
       (** [max_retries client] returns the maximum retry count. *)

     

       98
       98
       -
       

     

       99
       99
       -
       val retry_backoff : ('a,'b) t -> float

     

       100
       100
       -
       (** [retry_backoff client] returns the retry backoff factor. *)

     

       101
       101
       -
       

     

       102
       102
       -
       val verify_tls : ('a,'b) t -> bool

     

       103
       103
       -
       (** [verify_tls client] returns whether TLS verification is enabled. *)

     

       104
       104
       -
       

     

       105
       105
       -
       val tls_config : ('a,'b) t -> Tls.Config.client option

     

       106
       106
       -
       (** [tls_config client] returns the TLS configuration if set. *)

     

       44
       44
       +
       (** {1 HTTP Request Methods}

     

       107
       45
        
       

     

       108
       108
       -
       (** {1 HTTP Request Methods} *)

     

       46
       46
       +
           All functions are stateless - they open a new TCP connection for each request

     

       47
       47
       +
           and close it when the switch closes. No connection pooling or reuse. *)

     

       109
       48
        
       

     

       110
       49
        
       val request :

     

       111
       50
        
         sw:Eio.Switch.t ->

     

       112
       112
       -
         ?client:(_ Eio.Time.clock , _ Eio.Net.t) t ->

     

       51
       51
       +
         clock:_ Eio.Time.clock ->

     

       52
       52
       +
         net:_ Eio.Net.t ->

     

       113
       53
        
         ?headers:Headers.t ->

     

       114
       54
        
         ?body:Body.t ->

     

       115
       55
        
         ?auth:Auth.t ->

     

       116
       56
        
         ?timeout:Timeout.t ->

     

       117
       57
        
         ?follow_redirects:bool ->

     

       118
       58
        
         ?max_redirects:int ->

     

       59
       59
       +
         ?verify_tls:bool ->

     

       60
       60
       +
         ?tls_config:Tls.Config.client ->

     

       119
       61
        
         method_:Method.t ->

     

       120
       62
        
         string ->

     

       121
       63
        
         Response.t

     

       122
       122
       -
       (** Make a streaming request *)

     

       64
       64
       +
       (** [request ~sw ~clock ~net ?headers ?body ?auth ?timeout ?follow_redirects

     

       65
       65
       +
           ?max_redirects ?verify_tls ?tls_config ~method_ url] makes a single HTTP

     

       66
       66
       +
           request without connection pooling.

     

       67
       67
       +
       

     

       68
       68
       +
           Each call opens a new TCP connection (with TLS if https://), makes the

     

       69
       69
       +
           request, and closes the connection when the switch closes.

     

       70
       70
       +
       

     

       71
       71
       +
           @param sw Switch for resource management (response/connection bound to this)

     

       72
       72
       +
           @param clock Clock for timeouts

     

       73
       73
       +
           @param net Network interface for TCP connections

     

       74
       74
       +
           @param headers Request headers (default: empty)

     

       75
       75
       +
           @param body Request body (default: none)

     

       76
       76
       +
           @param auth Authentication to apply (default: none)

     

       77
       77
       +
           @param timeout Request timeout (default: 30s connect, 60s read)

     

       78
       78
       +
           @param follow_redirects Whether to follow HTTP redirects (default: true)

     

       79
       79
       +
           @param max_redirects Maximum redirects to follow (default: 10)

     

       80
       80
       +
           @param verify_tls Whether to verify TLS certificates (default: true)

     

       81
       81
       +
           @param tls_config Custom TLS configuration (default: system CA certs)

     

       82
       82
       +
           @param method_ HTTP method (GET, POST, etc.)

     

       83
       83
       +
           @param url URL to request

     

       84
       84
       +
       *)

     

       123
       85
        
       

     

       124
       86
        
       val get :

     

       125
       87
        
         sw:Eio.Switch.t ->

     

       126
       126
       -
         ?client:(_ Eio.Time.clock , _ Eio.Net.t) t ->

     

       88
       88
       +
         clock:_ Eio.Time.clock ->

     

       89
       89
       +
         net:_ Eio.Net.t ->

     

       127
       90
        
         ?headers:Headers.t ->

     

       128
       91
        
         ?auth:Auth.t ->

     

       129
       92
        
         ?timeout:Timeout.t ->

     

       130
       93
        
         ?follow_redirects:bool ->

     

       131
       94
        
         ?max_redirects:int ->

     

       95
       95
       +
         ?verify_tls:bool ->

     

       96
       96
       +
         ?tls_config:Tls.Config.client ->

     

       132
       97
        
         string ->

     

       133
       98
        
         Response.t

     

       134
       134
       -
       (** GET request *)

     

       99
       99
       +
       (** GET request. See {!request} for parameter details. *)

     

       135
       100
        
       

     

       136
       101
        
       val post :

     

       137
       102
        
         sw:Eio.Switch.t ->

     

       138
       138
       -
         ?client:(_ Eio.Time.clock , _ Eio.Net.t) t ->

     

       103
       103
       +
         clock:_ Eio.Time.clock ->

     

       104
       104
       +
         net:_ Eio.Net.t ->

     

       139
       105
        
         ?headers:Headers.t ->

     

       140
       106
        
         ?body:Body.t ->

     

       141
       107
        
         ?auth:Auth.t ->

     

       142
       108
        
         ?timeout:Timeout.t ->

     

       109
       109
       +
         ?verify_tls:bool ->

     

       110
       110
       +
         ?tls_config:Tls.Config.client ->

     

       143
       111
        
         string ->

     

       144
       112
        
         Response.t

     

       145
       145
       -
       (** POST request *)

     

       113
       113
       +
       (** POST request. See {!request} for parameter details. *)

     

       146
       114
        
       

     

       147
       115
        
       val put :

     

       148
       116
        
         sw:Eio.Switch.t ->

     

       149
       149
       -
         ?client:(_ Eio.Time.clock , _ Eio.Net.t) t ->

     

       117
       117
       +
         clock:_ Eio.Time.clock ->

     

       118
       118
       +
         net:_ Eio.Net.t ->

     

       150
       119
        
         ?headers:Headers.t ->

     

       151
       120
        
         ?body:Body.t ->

     

       152
       121
        
         ?auth:Auth.t ->

     

       153
       122
        
         ?timeout:Timeout.t ->

     

       123
       123
       +
         ?verify_tls:bool ->

     

       124
       124
       +
         ?tls_config:Tls.Config.client ->

     

       154
       125
        
         string ->

     

       155
       126
        
         Response.t

     

       156
       156
       -
       (** PUT request *)

     

       127
       127
       +
       (** PUT request. See {!request} for parameter details. *)

     

       157
       128
        
       

     

       158
       129
        
       val delete :

     

       159
       130
        
         sw:Eio.Switch.t ->

     

       160
       160
       -
         ?client:(_ Eio.Time.clock , _ Eio.Net.t) t ->

     

       131
       131
       +
         clock:_ Eio.Time.clock ->

     

       132
       132
       +
         net:_ Eio.Net.t ->

     

       161
       133
        
         ?headers:Headers.t ->

     

       162
       134
        
         ?auth:Auth.t ->

     

       163
       135
        
         ?timeout:Timeout.t ->

     

       136
       136
       +
         ?verify_tls:bool ->

     

       137
       137
       +
         ?tls_config:Tls.Config.client ->

     

       164
       138
        
         string ->

     

       165
       139
        
         Response.t

     

       166
       166
       -
       (** DELETE request *)

     

       140
       140
       +
       (** DELETE request. See {!request} for parameter details. *)

     

       167
       141
        
       

     

       168
       142
        
       val head :

     

       169
       143
        
         sw:Eio.Switch.t ->

     

       170
       170
       -
         ?client:(_ Eio.Time.clock , _ Eio.Net.t) t ->

     

       144
       144
       +
         clock:_ Eio.Time.clock ->

     

       145
       145
       +
         net:_ Eio.Net.t ->

     

       171
       146
        
         ?headers:Headers.t ->

     

       172
       147
        
         ?auth:Auth.t ->

     

       173
       148
        
         ?timeout:Timeout.t ->

     

       149
       149
       +
         ?verify_tls:bool ->

     

       150
       150
       +
         ?tls_config:Tls.Config.client ->

     

       174
       151
        
         string ->

     

       175
       152
        
         Response.t

     

       176
       176
       -
       (** HEAD request *)

     

       153
       153
       +
       (** HEAD request. See {!request} for parameter details. *)

     

       177
       154
        
       

     

       178
       155
        
       val patch :

     

       179
       156
        
         sw:Eio.Switch.t ->

     

       180
       180
       -
         ?client:(_ Eio.Time.clock , _ Eio.Net.t) t ->

     

       157
       157
       +
         clock:_ Eio.Time.clock ->

     

       158
       158
       +
         net:_ Eio.Net.t ->

     

       181
       159
        
         ?headers:Headers.t ->

     

       182
       160
        
         ?body:Body.t ->

     

       183
       161
        
         ?auth:Auth.t ->

     

       184
       162
        
         ?timeout:Timeout.t ->

     

       163
       163
       +
         ?verify_tls:bool ->

     

       164
       164
       +
         ?tls_config:Tls.Config.client ->

     

       185
       165
        
         string ->

     

       186
       166
        
         Response.t

     

       187
       187
       -
       (** PATCH request *)

     

       167
       167
       +
       (** PATCH request. See {!request} for parameter details. *)

     

       188
       168
        
       

     

       189
       169
        
       val upload :

     

       190
       170
        
         sw:Eio.Switch.t ->

     

       191
       191
       -
         ?client:(_ Eio.Time.clock , _ Eio.Net.t) t ->

     

       171
       171
       +
         clock:_ Eio.Time.clock ->

     

       172
       172
       +
         net:_ Eio.Net.t ->

     

       192
       173
        
         ?headers:Headers.t ->

     

       193
       174
        
         ?auth:Auth.t ->

     

       194
       175
        
         ?timeout:Timeout.t ->

     
···

       196
       177
        
         ?mime:Mime.t ->

     

       197
       178
        
         ?length:int64 ->

     

       198
       179
        
         ?on_progress:(sent:int64 -> total:int64 option -> unit) ->

     

       180
       180
       +
         ?verify_tls:bool ->

     

       181
       181
       +
         ?tls_config:Tls.Config.client ->

     

       199
       182
        
         source:Eio.Flow.source_ty Eio.Resource.t ->

     

       200
       183
        
         string ->

     

       201
       184
        
         Response.t

     

       202
       202
       -
       (** Upload from stream *)

     

       185
       185
       +
       (** Upload from stream. See {!request} for parameter details. *)

     

       203
       186
        
       

     

       204
       187
        
       val download :

     

       205
       188
        
         sw:Eio.Switch.t ->

     

       206
       206
       -
         ?client:(_ Eio.Time.clock , _ Eio.Net.t) t ->

     

       189
       189
       +
         clock:_ Eio.Time.clock ->

     

       190
       190
       +
         net:_ Eio.Net.t ->

     

       207
       191
        
         ?headers:Headers.t ->

     

       208
       192
        
         ?auth:Auth.t ->

     

       209
       193
        
         ?timeout:Timeout.t ->

     

       210
       194
        
         ?on_progress:(received:int64 -> total:int64 option -> unit) ->

     

       195
       195
       +
         ?verify_tls:bool ->

     

       196
       196
       +
         ?tls_config:Tls.Config.client ->

     

       211
       197
        
         string ->

     

       212
       198
        
         sink:Eio.Flow.sink_ty Eio.Resource.t ->

     

       213
       199
        
         unit

     

       214
       214
       -
       (** Download to stream *)

     

       200
       200
       +
       (** Download to stream. See {!request} for parameter details. *)

+239 -80

stack/requests/lib/requests.ml

···

       21
       21
        
          We don't call use_default() here as it spawns background threads

     

       22
       22
        
          that are incompatible with Eio's structured concurrency. *)

     

       23
       23
        
       

     

       24
       24
       -
       (* Main API - Session functionality with concurrent fiber spawning *)

     

       24
       24
       +
       (* Main API - Session functionality with connection pooling *)

     

       25
       25
        
       

     

       26
       26
        
       type ('clock, 'net) t = {

     

       27
       27
        
         sw : Eio.Switch.t;

     

       28
       28
       -
         client : ('clock, 'net) One.t;

     

       29
       28
        
         clock : 'clock;

     

       29
       29
       +
         net : 'net;

     

       30
       30
       +
       

     

       31
       31
       +
         (* Connection pools owned by this session *)

     

       32
       32
       +
         http_pool : ('clock, 'net) Conpool.t;

     

       33
       33
       +
         https_pool : ('clock, 'net) Conpool.t;

     

       34
       34
       +
       

     

       35
       35
       +
         (* Session state - immutable *)

     

       30
       36
        
         cookie_jar : Cookeio.jar;

     

       31
       37
        
         cookie_mutex : Eio.Mutex.t;

     

       32
       32
       -
         mutable default_headers : Headers.t;

     

       33
       33
       -
         mutable auth : Auth.t option;

     

       34
       34
       -
         mutable timeout : Timeout.t;

     

       35
       35
       -
         mutable follow_redirects : bool;

     

       36
       36
       -
         mutable max_redirects : int;

     

       37
       37
       -
         mutable retry : Retry.config option;

     

       38
       38
       +
         default_headers : Headers.t;

     

       39
       39
       +
         auth : Auth.t option;

     

       40
       40
       +
         timeout : Timeout.t;

     

       41
       41
       +
         follow_redirects : bool;

     

       42
       42
       +
         max_redirects : int;

     

       43
       43
       +
         verify_tls : bool;

     

       44
       44
       +
         tls_config : Tls.Config.client option;

     

       45
       45
       +
         retry : Retry.config option;

     

       38
       46
        
         persist_cookies : bool;

     

       39
       47
        
         xdg : Xdge.t option;

     

       40
       48
        
         cache : Cache.t option;

     

       41
       41
       -
         (* Statistics *)

     

       49
       49
       +
       

     

       50
       50
       +
         (* Statistics - mutable for tracking across all derived sessions *)

     

       42
       51
        
         mutable requests_made : int;

     

       43
       52
        
         mutable total_time : float;

     

       44
       53
        
         mutable retries_count : int;

     
···

       46
       55
        
       

     

       47
       56
        
       let create

     

       48
       57
        
           ~sw

     

       49
       49
       -
           ?client

     

       58
       58
       +
           ?http_pool

     

       59
       59
       +
           ?https_pool

     

       50
       60
        
           ?cookie_jar

     

       51
       61
        
           ?(default_headers = Headers.empty)

     

       52
       62
        
           ?auth

     
···

       54
       64
        
           ?(follow_redirects = true)

     

       55
       65
        
           ?(max_redirects = 10)

     

       56
       66
        
           ?(verify_tls = true)

     

       67
       67
       +
           ?tls_config

     

       68
       68
       +
           ?(max_connections_per_host = 10)

     

       69
       69
       +
           ?(connection_idle_timeout = 60.0)

     

       70
       70
       +
           ?(connection_lifetime = 300.0)

     

       57
       71
        
           ?retry

     

       58
       72
        
           ?(persist_cookies = false)

     

       59
       73
        
           ?(enable_cache = false)

     

       60
       74
        
           ?xdg

     

       61
       75
        
           env =

     

       62
       76
        
       

     

       77
       77
       +
         let clock = env#clock in

     

       78
       78
       +
         let net = env#net in

     

       79
       79
       +
       

     

       63
       80
        
         let xdg = match xdg, persist_cookies || enable_cache with

     

       64
       81
        
           | Some x, _ -> Some x

     

       65
       82
        
           | None, true -> Some (Xdge.create env#fs "requests")

     

       66
       83
        
           | None, false -> None

     

       67
       84
        
         in

     

       68
       85
        
       

     

       69
       69
       -
         let client = match client with

     

       70
       70
       -
           | Some c -> c

     

       86
       86
       +
         (* Create TLS config for HTTPS pool if needed *)

     

       87
       87
       +
         let tls_config = match tls_config, verify_tls with

     

       88
       88
       +
           | Some cfg, _ -> Some cfg

     

       89
       89
       +
           | None, true ->

     

       90
       90
       +
               (* Use CA certificates for verification *)

     

       91
       91
       +
               (match Ca_certs.authenticator () with

     

       92
       92
       +
                | Ok authenticator ->

     

       93
       93
       +
                    (match Tls.Config.client ~authenticator () with

     

       94
       94
       +
                     | Ok cfg -> Some cfg

     

       95
       95
       +
                     | Error (`Msg msg) ->

     

       96
       96
       +
                         Log.warn (fun m -> m "Failed to create TLS config: %s" msg);

     

       97
       97
       +
                         None)

     

       98
       98
       +
                | Error (`Msg msg) ->

     

       99
       99
       +
                    Log.warn (fun m -> m "Failed to load CA certificates: %s" msg);

     

       100
       100
       +
                    None)

     

       101
       101
       +
           | None, false -> None

     

       102
       102
       +
         in

     

       103
       103
       +
       

     

       104
       104
       +
         (* Create connection pools if not provided *)

     

       105
       105
       +
         let pool_config = Conpool.Config.make

     

       106
       106
       +
           ~max_connections_per_endpoint:max_connections_per_host

     

       107
       107
       +
           ~max_idle_time:connection_idle_timeout

     

       108
       108
       +
           ~max_connection_lifetime:connection_lifetime

     

       109
       109
       +
           ()

     

       110
       110
       +
         in

     

       111
       111
       +
       

     

       112
       112
       +
         (* HTTP pool - plain TCP connections *)

     

       113
       113
       +
         let http_pool = match http_pool with

     

       114
       114
       +
           | Some p -> p

     

       71
       115
        
           | None ->

     

       72
       72
       -
               One.create ~sw ~verify_tls ~timeout

     

       73
       73
       -
                 ~clock:env#clock ~net:env#net ()

     

       116
       116
       +
               Conpool.create ~sw ~net ~clock ~config:pool_config ()

     

       74
       117
        
         in

     

       75
       118
        
       

     

       119
       119
       +
         (* HTTPS pool - TLS-wrapped connections *)

     

       120
       120
       +
         let https_pool = match https_pool with

     

       121
       121
       +
           | Some p -> p

     

       122
       122
       +
           | None ->

     

       123
       123
       +
               let https_tls_config = Option.map (fun cfg ->

     

       124
       124
       +
                 Conpool.Tls_config.make ~config:cfg ()

     

       125
       125
       +
               ) tls_config in

     

       126
       126
       +
               Conpool.create ~sw ~net ~clock ?tls:https_tls_config ~config:pool_config ()

     

       127
       127
       +
         in

     

       128
       128
       +
       

     

       129
       129
       +
         Log.info (fun m -> m "Created Requests session with connection pools (max_per_host=%d, TLS=%b)"

     

       130
       130
       +
           max_connections_per_host (Option.is_some tls_config));

     

       131
       131
       +
       

     

       76
       132
        
         let cookie_jar = match cookie_jar, persist_cookies, xdg with

     

       77
       133
        
           | Some jar, _, _ -> jar

     

       78
       134
        
           | None, true, Some xdg_ctx ->

     
···

       95
       151
        
       

     

       96
       152
        
         {

     

       97
       153
        
           sw;

     

       98
       98
       -
           client;

     

       99
       99
       -
           clock = env#clock;

     

       154
       154
       +
           clock;

     

       155
       155
       +
           net;

     

       156
       156
       +
           http_pool;

     

       157
       157
       +
           https_pool;

     

       100
       158
        
           cookie_jar;

     

       101
       159
        
           cookie_mutex = Eio.Mutex.create ();

     

       102
       160
        
           default_headers;

     
···

       104
       162
        
           timeout;

     

       105
       163
        
           follow_redirects;

     

       106
       164
        
           max_redirects;

     

       165
       165
       +
           verify_tls;

     

       166
       166
       +
           tls_config;

     

       107
       167
        
           retry;

     

       108
       168
        
           persist_cookies;

     

       109
       169
        
           xdg;

     
···

       113
       173
        
           retries_count = 0;

     

       114
       174
        
         }

     

       115
       175
        
       

     

       116
       116
       -
       (* Configuration management *)

     

       117
       176
        
       let set_default_header t key value =

     

       118
       118
       -
         t.default_headers <- Headers.set key value t.default_headers

     

       177
       177
       +
         { t with default_headers = Headers.set key value t.default_headers }

     

       119
       178
        
       

     

       120
       179
        
       let remove_default_header t key =

     

       121
       121
       -
         t.default_headers <- Headers.remove key t.default_headers

     

       180
       180
       +
         { t with default_headers = Headers.remove key t.default_headers }

     

       122
       181
        
       

     

       123
       182
        
       let set_auth t auth =

     

       124
       183
        
         Log.debug (fun m -> m "Setting authentication method");

     

       125
       125
       -
         t.auth <- Some auth

     

       184
       184
       +
         { t with auth = Some auth }

     

       126
       185
        
       

     

       127
       186
        
       let clear_auth t =

     

       128
       187
        
         Log.debug (fun m -> m "Clearing authentication");

     

       129
       129
       -
         t.auth <- None

     

       188
       188
       +
         { t with auth = None }

     

       130
       189
        
       

     

       131
       190
        
       let set_timeout t timeout =

     

       132
       191
        
         Log.debug (fun m -> m "Setting timeout: %a" Timeout.pp timeout);

     

       133
       133
       -
         t.timeout <- timeout

     

       192
       192
       +
         { t with timeout }

     

       134
       193
        
       

     

       135
       194
        
       let set_retry t config =

     

       136
       195
        
         Log.debug (fun m -> m "Setting retry config: max_retries=%d" config.Retry.max_retries);

     

       137
       137
       -
         t.retry <- Some config

     

       196
       196
       +
         { t with retry = Some config }

     

       138
       197
        
       

     

       139
       198
        
       let cookies t = t.cookie_jar

     

       140
       199
        
       let clear_cookies t = Cookeio.clear t.cookie_jar

     

       141
       200
        
       

     

       142
       142
       -
       (* Internal request function that runs in a fiber *)

     

       201
       201
       +
       (* Internal request function using connection pools *)

     

       143
       202
        
       let make_request_internal t ?headers ?body ?auth ?timeout ?follow_redirects ?max_redirects ~method_ url =

     

       144
       144
       -
         Log.info (fun m -> m "Making %s request to %s" (Method.to_string method_) url);

     

       203
       203
       +
         let start_time = Unix.gettimeofday () in

     

       204
       204
       +
         let method_str = Method.to_string method_ in

     

       205
       205
       +
       

     

       206
       206
       +
         Log.info (fun m -> m "Making %s request to %s" method_str url);

     

       207
       207
       +
       

     

       208
       208
       +
         (* Parse URL *)

     

       209
       209
       +
         let uri = Uri.of_string url in

     

       210
       210
       +
         let domain = Option.value ~default:"" (Uri.host uri) in

     

       211
       211
       +
         let path = Uri.path uri in

     

       212
       212
       +
         let is_secure = Uri.scheme uri = Some "https" in

     

       213
       213
       +
       

     

       145
       214
        
         (* Merge headers *)

     

       146
       215
        
         let headers = match headers with

     

       147
       216
        
           | Some h -> Headers.merge t.default_headers h

     
···

       154
       223
        
           | None -> t.auth

     

       155
       224
        
         in

     

       156
       225
        
       

     

       157
       157
       -
         (* Get cookies for this URL *)

     

       158
       158
       -
         let uri = Uri.of_string url in

     

       159
       159
       -
         let domain = Option.value ~default:"" (Uri.host uri) in

     

       160
       160
       -
         let path = Uri.path uri in

     

       161
       161
       -
         let is_secure = Uri.scheme uri = Some "https" in

     

       226
       226
       +
         (* Apply auth *)

     

       227
       227
       +
         let headers = match auth with

     

       228
       228
       +
           | Some a ->

     

       229
       229
       +
               Log.debug (fun m -> m "Applying authentication");

     

       230
       230
       +
               Auth.apply a headers

     

       231
       231
       +
           | None -> headers

     

       232
       232
       +
         in

     

       162
       233
        
       

     

       234
       234
       +
         (* Add content type from body *)

     

       235
       235
       +
         let headers = match body with

     

       236
       236
       +
           | Some b -> (match Body.content_type b with

     

       237
       237
       +
               | Some mime -> Headers.content_type mime headers

     

       238
       238
       +
               | None -> headers)

     

       239
       239
       +
           | None -> headers

     

       240
       240
       +
         in

     

       241
       241
       +
       

     

       242
       242
       +
         (* Get cookies for this URL *)

     

       163
       243
        
         let headers =

     

       164
       244
        
           Eio.Mutex.use_ro t.cookie_mutex (fun () ->

     

       165
       245
        
             let cookies = Cookeio.get_cookies t.cookie_jar ~domain ~path ~is_secure in

     
···

       172
       252
        
           )

     

       173
       253
        
         in

     

       174
       254
        
       

     

       255
       255
       +
         (* Convert body to string for sending *)

     

       256
       256
       +
         let request_body_str = match body with

     

       257
       257
       +
           | None -> ""

     

       258
       258
       +
           | Some b -> Body.Private.to_string b

     

       259
       259
       +
         in

     

       260
       260
       +
       

     

       175
       261
        
         (* Check cache for GET and HEAD requests when body is not present *)

     

       176
       176
       -
         let response = match t.cache, method_, body with

     

       262
       262
       +
         let cached_response = match t.cache, method_, body with

     

       177
       263
        
           | Some cache, (`GET | `HEAD), None ->

     

       178
       178
       -
               Log.debug (fun m -> m "Checking cache for %s request to %s" (Method.to_string method_) url);

     

       264
       264
       +
               Log.debug (fun m -> m "Checking cache for %s request to %s" method_str url);

     

       179
       265
        
               let headers_cohttp = Cohttp.Header.of_list (Headers.to_list headers) in

     

       180
       180
       -
               (match Cache.get cache ~method_ ~url:uri ~headers:headers_cohttp with

     

       181
       181
       -
                | Some cached_response ->

     

       182
       182
       -
                    Log.info (fun m -> m "Cache HIT for %s request to %s" (Method.to_string method_) url);

     

       183
       183
       -
                    (* Convert cached response to Response.t *)

     

       184
       184
       -
                    let status = Cohttp.Code.code_of_status cached_response.Cache.status in

     

       185
       185
       -
                    let resp_headers = Headers.of_list (Cohttp.Header.to_list cached_response.Cache.headers) in

     

       186
       186
       -
                    let body_flow = Eio.Flow.string_source cached_response.Cache.body in

     

       187
       187
       -
                    Response.make ~sw:t.sw ~status ~headers:resp_headers ~body:body_flow ~url ~elapsed:0.0

     

       188
       188
       -
                | None ->

     

       189
       189
       -
                    Log.info (fun m -> m "Cache MISS for %s request to %s" (Method.to_string method_) url);

     

       190
       190
       -
                    (* Make the actual request *)

     

       191
       191
       -
                    let response = One.request ~sw:t.sw ~client:t.client

     

       192
       192
       -
                      ?body ?auth

     

       193
       193
       -
                      ~timeout:(Option.value timeout ~default:t.timeout)

     

       194
       194
       -
                      ~follow_redirects:(Option.value follow_redirects ~default:t.follow_redirects)

     

       195
       195
       -
                      ~max_redirects:(Option.value max_redirects ~default:t.max_redirects)

     

       196
       196
       -
                      ~headers ~method_ url

     

       197
       197
       -
                    in

     

       198
       198
       -
                    (* Store in cache if successful *)

     

       199
       199
       -
                    (match t.cache with

     

       200
       200
       -
                     | Some cache when Response.ok response ->

     

       201
       201
       -
                         Log.debug (fun m -> m "Storing response in cache for %s" url);

     

       202
       202
       -
                         let status_code = Response.status_code response in

     

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

     

       204
       204
       -
                         let resp_headers = Response.headers response in

     

       205
       205
       -
                         let resp_headers_cohttp = Cohttp.Header.of_list (Headers.to_list resp_headers) in

     

       206
       206
       -
                         (* Read body to cache it *)

     

       207
       207
       -
                         let body_flow = Response.body response in

     

       208
       208
       -
                         let buf = Buffer.create 4096 in

     

       209
       209
       -
                         Eio.Flow.copy body_flow (Eio.Flow.buffer_sink buf);

     

       210
       210
       -
                         let body_str = Buffer.contents buf in

     

       211
       211
       -
                         Cache.put cache ~method_ ~url:uri ~request_headers:headers_cohttp

     

       212
       212
       -
                           ~status ~headers:resp_headers_cohttp ~body:body_str;

     

       213
       213
       -
                         (* Return a new response with the buffered body *)

     

       214
       214
       -
                         let new_body_flow = Eio.Flow.string_source body_str in

     

       215
       215
       -
                         Response.make ~sw:t.sw ~status:status_code ~headers:resp_headers ~body:new_body_flow ~url ~elapsed:0.0

     

       216
       216
       -
                     | _ -> response))

     

       217
       217
       -
           | _ ->

     

       218
       218
       -
               Log.debug (fun m -> m "Cache not applicable for %s request to %s (cache enabled: %b, body present: %b)"

     

       219
       219
       -
                 (Method.to_string method_) url (Option.is_some t.cache) (Option.is_some body));

     

       220
       220
       -
               (* Make the actual request without caching *)

     

       221
       221
       -
               One.request ~sw:t.sw ~client:t.client

     

       222
       222
       -
                 ?body ?auth

     

       223
       223
       -
                 ~timeout:(Option.value timeout ~default:t.timeout)

     

       224
       224
       -
                 ~follow_redirects:(Option.value follow_redirects ~default:t.follow_redirects)

     

       225
       225
       -
                 ~max_redirects:(Option.value max_redirects ~default:t.max_redirects)

     

       226
       226
       -
                 ~headers ~method_ url

     

       266
       266
       +
               Cache.get cache ~method_ ~url:uri ~headers:headers_cohttp

     

       267
       267
       +
           | _ -> None

     

       268
       268
       +
         in

     

       269
       269
       +
       

     

       270
       270
       +
         let response = match cached_response with

     

       271
       271
       +
           | Some cached ->

     

       272
       272
       +
               Log.info (fun m -> m "Cache HIT for %s request to %s" method_str url);

     

       273
       273
       +
               (* Convert cached response to Response.t *)

     

       274
       274
       +
               let status = Cohttp.Code.code_of_status cached.Cache.status in

     

       275
       275
       +
               let resp_headers = Headers.of_list (Cohttp.Header.to_list cached.Cache.headers) in

     

       276
       276
       +
               let body_flow = Eio.Flow.string_source cached.Cache.body in

     

       277
       277
       +
               Response.Private.make ~sw:t.sw ~status ~headers:resp_headers ~body:body_flow ~url ~elapsed:0.0

     

       278
       278
       +
           | None ->

     

       279
       279
       +
               Log.info (fun m -> m "Cache MISS or not applicable for %s request to %s" method_str url);

     

       280
       280
       +
       

     

       281
       281
       +
               (* Execute request with redirect handling *)

     

       282
       282
       +
               let rec make_with_redirects url_to_fetch redirects_left =

     

       283
       283
       +
                 let uri_to_fetch = Uri.of_string url_to_fetch in

     

       284
       284
       +
       

     

       285
       285
       +
                 (* Parse the redirect URL to get correct host and port *)

     

       286
       286
       +
                 let redirect_host = match Uri.host uri_to_fetch with

     

       287
       287
       +
                   | Some h -> h

     

       288
       288
       +
                   | None -> failwith "Redirect URL must contain a host"

     

       289
       289
       +
                 in

     

       290
       290
       +
                 let redirect_port = match Uri.scheme uri_to_fetch, Uri.port uri_to_fetch with

     

       291
       291
       +
                   | Some "https", None -> 443

     

       292
       292
       +
                   | Some "https", Some p -> p

     

       293
       293
       +
                   | Some "http", None -> 80

     

       294
       294
       +
                   | Some "http", Some p -> p

     

       295
       295
       +
                   | _, Some p -> p

     

       296
       296
       +
                   | _ -> 80

     

       297
       297
       +
                 in

     

       298
       298
       +
       

     

       299
       299
       +
                 (* Create endpoint for this specific URL *)

     

       300
       300
       +
                 let redirect_endpoint = Conpool.Endpoint.make ~host:redirect_host ~port:redirect_port in

     

       301
       301
       +
       

     

       302
       302
       +
                 (* Determine if we need TLS based on this URL's scheme *)

     

       303
       303
       +
                 let redirect_is_https = match Uri.scheme uri_to_fetch with

     

       304
       304
       +
                   | Some "https" -> true

     

       305
       305
       +
                   | _ -> false

     

       306
       306
       +
                 in

     

       307
       307
       +
       

     

       308
       308
       +
                 (* Choose the appropriate connection pool for this URL *)

     

       309
       309
       +
                 let redirect_pool = if redirect_is_https then t.https_pool else t.http_pool in

     

       310
       310
       +
       

     

       311
       311
       +
                 let make_request_fn () =

     

       312
       312
       +
                   Conpool.with_connection redirect_pool redirect_endpoint (fun flow ->

     

       313
       313
       +
                     (* Flow is already TLS-wrapped if from https_pool, plain TCP if from http_pool *)

     

       314
       314
       +
                     (* Use our low-level HTTP client *)

     

       315
       315
       +
                     Http_client.make_request ~method_:method_str ~uri:uri_to_fetch

     

       316
       316
       +
                       ~headers ~body_str:request_body_str flow

     

       317
       317
       +
                   )

     

       318
       318
       +
                 in

     

       319
       319
       +
       

     

       320
       320
       +
                 (* Apply timeout if specified *)

     

       321
       321
       +
                 let status, resp_headers, response_body_str =

     

       322
       322
       +
                   let timeout_val = Option.value timeout ~default:t.timeout in

     

       323
       323
       +
                   match Timeout.total timeout_val with

     

       324
       324
       +
                   | Some seconds ->

     

       325
       325
       +
                       Log.debug (fun m -> m "Setting timeout: %.2f seconds" seconds);

     

       326
       326
       +
                       Eio.Time.with_timeout_exn t.clock seconds make_request_fn

     

       327
       327
       +
                   | None -> make_request_fn ()

     

       328
       328
       +
                 in

     

       329
       329
       +
       

     

       330
       330
       +
                 Log.info (fun m -> m "Received response: status=%d" status);

     

       331
       331
       +
       

     

       332
       332
       +
                 (* Handle redirects if enabled *)

     

       333
       333
       +
                 let follow = Option.value follow_redirects ~default:t.follow_redirects in

     

       334
       334
       +
                 let max_redir = Option.value max_redirects ~default:t.max_redirects in

     

       335
       335
       +
       

     

       336
       336
       +
                 if follow && (status >= 300 && status < 400) then begin

     

       337
       337
       +
                   if redirects_left <= 0 then begin

     

       338
       338
       +
                     Log.err (fun m -> m "Too many redirects (%d) for %s" max_redir url);

     

       339
       339
       +
                     raise (Error.TooManyRedirects { url; count = max_redir; max = max_redir })

     

       340
       340
       +
                   end;

     

       341
       341
       +
       

     

       342
       342
       +
                   match Headers.get "location" resp_headers with

     

       343
       343
       +
                   | None ->

     

       344
       344
       +
                       Log.debug (fun m -> m "Redirect response missing Location header");

     

       345
       345
       +
                       (status, resp_headers, response_body_str, url_to_fetch)

     

       346
       346
       +
                   | Some location ->

     

       347
       347
       +
                       Log.info (fun m -> m "Following redirect to %s (%d remaining)" location redirects_left);

     

       348
       348
       +
                       make_with_redirects location (redirects_left - 1)

     

       349
       349
       +
                 end else

     

       350
       350
       +
                   (status, resp_headers, response_body_str, url_to_fetch)

     

       351
       351
       +
               in

     

       352
       352
       +
       

     

       353
       353
       +
               let max_redir = Option.value max_redirects ~default:t.max_redirects in

     

       354
       354
       +
               let final_status, final_headers, final_body_str, final_url =

     

       355
       355
       +
                 make_with_redirects url max_redir

     

       356
       356
       +
               in

     

       357
       357
       +
       

     

       358
       358
       +
               let elapsed = Unix.gettimeofday () -. start_time in

     

       359
       359
       +
               Log.info (fun m -> m "Request completed in %.3f seconds" elapsed);

     

       360
       360
       +
       

     

       361
       361
       +
               (* Store in cache if successful and caching enabled *)

     

       362
       362
       +
               (match t.cache with

     

       363
       363
       +
                | Some cache when final_status >= 200 && final_status < 300 ->

     

       364
       364
       +
                    Log.debug (fun m -> m "Storing response in cache for %s" url);

     

       365
       365
       +
                    let status = Cohttp.Code.status_of_code final_status in

     

       366
       366
       +
                    let resp_headers_cohttp = Cohttp.Header.of_list (Headers.to_list final_headers) in

     

       367
       367
       +
                    let headers_cohttp = Cohttp.Header.of_list (Headers.to_list headers) in

     

       368
       368
       +
                    Cache.put cache ~method_ ~url:uri ~request_headers:headers_cohttp

     

       369
       369
       +
                      ~status ~headers:resp_headers_cohttp ~body:final_body_str

     

       370
       370
       +
                | _ -> ());

     

       371
       371
       +
       

     

       372
       372
       +
               (* Create a flow from the body string *)

     

       373
       373
       +
               let body_flow = Eio.Flow.string_source final_body_str in

     

       374
       374
       +
       

     

       375
       375
       +
               Response.Private.make

     

       376
       376
       +
                 ~sw:t.sw

     

       377
       377
       +
                 ~status:final_status

     

       378
       378
       +
                 ~headers:final_headers

     

       379
       379
       +
                 ~body:body_flow

     

       380
       380
       +
                 ~url:final_url

     

       381
       381
       +
                 ~elapsed

     

       227
       382
        
         in

     

       228
       383
        
       

     

       229
       384
        
         (* Extract and store cookies from response *)

     
···

       246
       401
        
       

     

       247
       402
        
         (* Update statistics *)

     

       248
       403
        
         t.requests_made <- t.requests_made + 1;

     

       404
       404
       +
         t.total_time <- t.total_time +. (Unix.gettimeofday () -. start_time);

     

       249
       405
        
         Log.info (fun m -> m "Request completed with status %d" (Response.status_code response));

     

       250
       406
        
       

     

       251
       407
        
         response

     
···

       323
       479
        
             env in

     

       324
       480
        
       

     

       325
       481
        
           (* Set user agent if provided *)

     

       326
       326
       -
           Option.iter (set_default_header req "User-Agent") config.user_agent;

     

       482
       482
       +
           let req = match config.user_agent with

     

       483
       483
       +
             | Some ua -> set_default_header req "User-Agent" ua

     

       484
       484
       +
             | None -> req

     

       485
       485
       +
           in

     

       327
       486
        
       

     

       328
       487
        
           req

     

       329
       488

+43 -16

stack/requests/lib/requests.mli

···

       133
       133
        
       *)

     

       134
       134
        
       

     

       135
       135
        
       type ('clock, 'net) t

     

       136
       136
       -
       (** A stateful HTTP client that maintains cookies, auth, and configuration across requests. *)

     

       136
       136
       +
       (** A stateful HTTP client that maintains cookies, auth, configuration, and

     

       137
       137
       +
           connection pools across requests. *)

     

       137
       138
        
       

     

       138
       139
        
       (** {2 Creation and Configuration} *)

     

       139
       140
        
       

     

       140
       141
        
       val create :

     

       141
       142
        
         sw:Eio.Switch.t ->

     

       142
       142
       -
         ?client:('clock Eio.Time.clock,'net Eio.Net.t) One.t ->

     

       143
       143
       +
         ?http_pool:('clock Eio.Time.clock, 'net Eio.Net.t) Conpool.t ->

     

       144
       144
       +
         ?https_pool:('clock Eio.Time.clock, 'net Eio.Net.t) Conpool.t ->

     

       143
       145
        
         ?cookie_jar:Cookeio.jar ->

     

       144
       146
        
         ?default_headers:Headers.t ->

     

       145
       147
        
         ?auth:Auth.t ->

     
···

       147
       149
        
         ?follow_redirects:bool ->

     

       148
       150
        
         ?max_redirects:int ->

     

       149
       151
        
         ?verify_tls:bool ->

     

       152
       152
       +
         ?tls_config:Tls.Config.client ->

     

       153
       153
       +
         ?max_connections_per_host:int ->

     

       154
       154
       +
         ?connection_idle_timeout:float ->

     

       155
       155
       +
         ?connection_lifetime:float ->

     

       150
       156
        
         ?retry:Retry.config ->

     

       151
       157
        
         ?persist_cookies:bool ->

     

       152
       158
        
         ?enable_cache:bool ->

     

       153
       159
        
         ?xdg:Xdge.t ->

     

       154
       160
        
         < clock: 'clock Eio.Resource.t; net: 'net Eio.Resource.t; fs: Eio.Fs.dir_ty Eio.Path.t; .. > ->

     

       155
       161
        
         ('clock Eio.Resource.t, 'net Eio.Resource.t) t

     

       156
       156
       -
       (** Create a new requests instance with persistent state.

     

       157
       157
       -
           All resources are bound to the provided switch and will be cleaned up automatically. *)

     

       162
       162
       +
       (** Create a new requests instance with persistent state and connection pooling.

     

       163
       163
       +
           All resources are bound to the provided switch and will be cleaned up automatically.

     

       164
       164
       +
       

     

       165
       165
       +
           @param sw Switch for resource management

     

       166
       166
       +
           @param http_pool Optional pre-configured HTTP connection pool (creates new if not provided)

     

       167
       167
       +
           @param https_pool Optional pre-configured HTTPS connection pool (creates new if not provided)

     

       168
       168
       +
           @param cookie_jar Cookie storage (default: empty in-memory jar)

     

       169
       169
       +
           @param default_headers Headers included in every request

     

       170
       170
       +
           @param auth Default authentication

     

       171
       171
       +
           @param timeout Default timeout configuration

     

       172
       172
       +
           @param follow_redirects Whether to follow HTTP redirects (default: true)

     

       173
       173
       +
           @param max_redirects Maximum redirects to follow (default: 10)

     

       174
       174
       +
           @param verify_tls Whether to verify TLS certificates (default: true)

     

       175
       175
       +
           @param tls_config Custom TLS configuration for HTTPS pool (default: system CA certs)

     

       176
       176
       +
           @param max_connections_per_host Maximum pooled connections per host:port (default: 10)

     

       177
       177
       +
           @param connection_idle_timeout Max idle time before closing pooled connection (default: 60s)

     

       178
       178
       +
           @param connection_lifetime Max lifetime of any pooled connection (default: 300s)

     

       179
       179
       +
           @param retry Retry configuration for failed requests

     

       180
       180
       +
           @param persist_cookies Whether to persist cookies to disk (default: false)

     

       181
       181
       +
           @param enable_cache Whether to enable HTTP caching (default: false)

     

       182
       182
       +
           @param xdg XDG directory context for cookies/cache (required if persist_cookies or enable_cache)

     

       183
       183
       +
       *)

     

       158
       184
        
       

     

       159
       185
        
       (** {2 Configuration Management} *)

     

       160
       186
        
       

     

       161
       161
       -
       val set_default_header : ('clock, 'net) t -> string -> string -> unit

     

       162
       162
       -
       (** Set a default header for all requests *)

     

       187
       187
       +
       val set_default_header : ('clock, 'net) t -> string -> string -> ('clock, 'net) t

     

       188
       188
       +
       (** Add or update a default header. Returns a new session with the updated header.

     

       189
       189
       +
           The original session's connection pools are shared. *)

     

       163
       190
        
       

     

       164
       164
       -
       val remove_default_header : ('clock, 'net) t -> string -> unit

     

       165
       165
       -
       (** Remove a default header *)

     

       191
       191
       +
       val remove_default_header : ('clock, 'net) t -> string -> ('clock, 'net) t

     

       192
       192
       +
       (** Remove a default header. Returns a new session without the header. *)

     

       166
       193
        
       

     

       167
       167
       -
       val set_auth : ('clock, 'net) t -> Auth.t -> unit

     

       168
       168
       -
       (** Set default authentication *)

     

       194
       194
       +
       val set_auth : ('clock, 'net) t -> Auth.t -> ('clock, 'net) t

     

       195
       195
       +
       (** Set default authentication. Returns a new session with auth configured. *)

     

       169
       196
        
       

     

       170
       170
       -
       val clear_auth : ('clock, 'net) t -> unit

     

       171
       171
       -
       (** Clear authentication *)

     

       197
       197
       +
       val clear_auth : ('clock, 'net) t -> ('clock, 'net) t

     

       198
       198
       +
       (** Clear authentication. Returns a new session without auth. *)

     

       172
       199
        
       

     

       173
       173
       -
       val set_timeout : ('clock, 'net) t -> Timeout.t -> unit

     

       174
       174
       -
       (** Set default timeout *)

     

       200
       200
       +
       val set_timeout : ('clock, 'net) t -> Timeout.t -> ('clock, 'net) t

     

       201
       201
       +
       (** Set default timeout. Returns a new session with the timeout configured. *)

     

       175
       202
        
       

     

       176
       176
       -
       val set_retry : ('clock, 'net) t -> Retry.config -> unit

     

       177
       177
       -
       (** Set retry configuration *)

     

       203
       203
       +
       val set_retry : ('clock, 'net) t -> Retry.config -> ('clock, 'net) t

     

       204
       204
       +
       (** Set retry configuration. Returns a new session with retry configured. *)

     

       178
       205
        
       

     

       179
       206
        
       (** {2 Request Methods}

     

       180
       207

+12 -23

stack/requests/test/test_connection_pool.ml

···

       1
       1
       -
       (** Test connection pooling with conpool integration *)

     

       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_connection_pooling () =

     

       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 connection pool activity *)

     

       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 Conpool.src (Some Logs.Info);

     

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

     

       17
       16
        
       

     

       18
       18
       -
         traceln "=== Testing Connection Pooling ===\n";

     

       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
       -
         (* Create a client with connection pooling *)

     

       21
       21
       -
         let client = Requests.One.create

     

       22
       22
       -
           ~sw

     

       23
       23
       -
           ~clock:env#clock

     

       24
       24
       -
           ~net:env#net

     

       25
       25
       -
           ~max_connections_per_host:5

     

       26
       26
       -
           ~connection_idle_timeout:30.0

     

       27
       27
       -
           ~verify_tls:true

     

       28
       28
       -
           ()

     

       29
       29
       -
         in

     

       30
       30
       -
       

     

       31
       31
       -
         traceln "Client created with connection pool";

     

       32
       32
       -
         traceln "Making 10 requests to example.com...\n";

     

       33
       33
       -
       

     

       34
       34
       -
         (* Make multiple requests to the same host *)

     

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

     

       35
       21
        
         let start_time = Unix.gettimeofday () in

     

       36
       22
        
       

     

       37
       23
        
         for i = 1 to 10 do

     

       38
       24
        
           traceln "Request %d:" i;

     

       39
       39
       -
           let response = Requests.One.get ~sw ~client "http://example.com" in

     

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

     

       26
       26
       +
             ~clock:env#clock ~net:env#net

     

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

     

       28
       28
       +
           in

     

       40
       29
        
       

     

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

     

       42
       31
        
           traceln "  Content-Length: %s"

     
···

       44
       33
        
              | Some len -> Int64.to_string len

     

       45
       34
        
              | None -> "unknown");

     

       46
       35
        
       

     

       47
       47
       -
           (* Body already drained - connection automatically returned to pool *)

     

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

     

       48
       37
        
           traceln ""

     

       49
       38
        
         done;

     

       50
       39
        
       

     
···

       56
       45
        
       

     

       57
       46
        
       let () =

     

       58
       47
        
         try

     

       59
       59
       -
           test_connection_pooling ()

     

       48
       48
       +
           test_one_stateless ()

     

       60
       49
        
         with e ->

     

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

     

       62
       51
        
           Printexc.print_backtrace stdout;

+7 -5

stack/requests/test/test_requests.ml

···

       705
       705
        
         end in

     

       706
       706
        
         Test_server.start_server ~port test_env;

     

       707
       707
        
       

     

       708
       708
       -
         let client = Requests.One.create ~sw ~clock:env#clock ~net:env#net () in

     

       709
       709
       -
         let response = Requests.One.get ~sw ~client (base_url ^ "/echo") in

     

       708
       708
       +
         let response = Requests.One.get ~sw

     

       709
       709
       +
           ~clock:env#clock ~net:env#net

     

       710
       710
       +
           (base_url ^ "/echo")

     

       711
       711
       +
         in

     

       710
       712
        
       

     

       711
       713
        
         Alcotest.(check int) "One module status" 200 (Requests.Response.status_code response)

     

       712
       714
        
       

     
···

       815
       817
        
       

     

       816
       818
        
         let req = Requests.create ~sw env in

     

       817
       819
        
       

     

       818
       818
       -
         Requests.set_default_header req "X-Session" "session-123";

     

       820
       820
       +
         let req = Requests.set_default_header req "X-Session" "session-123" in

     

       819
       821
        
       

     

       820
       822
        
         let auth = Requests.Auth.bearer ~token:"test_token" in

     

       821
       821
       -
         Requests.set_auth req auth;

     

       823
       823
       +
         let req = Requests.set_auth req auth in

     

       822
       824
        
       

     

       823
       825
        
         let response1 = Requests.get req (base_url ^ "/echo") in

     

       824
       826
        
         let body_str1 = Requests.Response.body response1 |> Eio.Flow.read_all in

     
···

       834
       836
        
       

     

       835
       837
        
         Alcotest.(check string) "Session header persisted" "session-123" session_header;

     

       836
       838
        
       

     

       837
       837
       -
         Requests.remove_default_header req "X-Session";

     

       839
       839
       +
         let req = Requests.remove_default_header req "X-Session" in

     

       838
       840
        
       

     

       839
       841
        
         let response2 = Requests.get req (base_url ^ "/echo") in

     

       840
       842
        
         let body_str2 = Requests.Response.body response2 |> Eio.Flow.read_all in

stack/typesense-cliente/dune

···

       1
       1
       +
       (library

     

       2
       2
       +
        (public_name typesense-cliente)

     

       3
       3
       +
        (name typesense_cliente)

     

       4
       4
       +
        (libraries eio requests ezjsonm fmt uri ptime))

+18

stack/typesense-cliente/dune-project

···

       1
       1
       +
       (lang dune 3.0)

     

       2
       2
       +
       (name typesense-cliente)

     

       3
       3
       +
       (version 0.1.0)

     

       4
       4
       +
       

     

       5
       5
       +
       (generate_opam_files true)

     

       6
       6
       +
       

     

       7
       7
       +
       (package

     

       8
       8
       +
        (name typesense-cliente)

     

       9
       9
       +
        (synopsis "Typesense search API client for OCaml using Eio")

     

       10
       10
       +
        (description "An Eio-based OCaml client library for Typesense search engine")

     

       11
       11
       +
        (depends

     

       12
       12
       +
         (ocaml (>= 4.14))

     

       13
       13
       +
         eio

     

       14
       14
       +
         requests

     

       15
       15
       +
         ezjsonm

     

       16
       16
       +
         fmt

     

       17
       17
       +
         uri

     

       18
       18
       +
         ptime))

+30

stack/typesense-cliente/typesense-cliente.opam

···

       1
       1
       +
       # This file is generated by dune, edit dune-project instead

     

       2
       2
       +
       opam-version: "2.0"

     

       3
       3
       +
       version: "0.1.0"

     

       4
       4
       +
       synopsis: "Typesense search API client for OCaml using Eio"

     

       5
       5
       +
       description: "An Eio-based OCaml client library for Typesense search engine"

     

       6
       6
       +
       depends: [

     

       7
       7
       +
         "dune" {>= "3.0"}

     

       8
       8
       +
         "ocaml" {>= "4.14"}

     

       9
       9
       +
         "eio"

     

       10
       10
       +
         "requests"

     

       11
       11
       +
         "ezjsonm"

     

       12
       12
       +
         "fmt"

     

       13
       13
       +
         "uri"

     

       14
       14
       +
         "ptime"

     

       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
       +
       ]

+85

stack/typesense-cliente/typesense_cliente.mli

···

       1
       1
       +
       (** Typesense client for OCaml using Eio and Requests *)

     

       2
       2
       +
       

     

       3
       3
       +
       (** Configuration for Typesense client *)

     

       4
       4
       +
       type config = {

     

       5
       5
       +
         endpoint : string;

     

       6
       6
       +
         api_key : string;

     

       7
       7
       +
       }

     

       8
       8
       +
       

     

       9
       9
       +
       (** Error types for Typesense operations *)

     

       10
       10
       +
       type error =

     

       11
       11
       +
         | Http_error of int * string

     

       12
       12
       +
         | Json_error of string

     

       13
       13
       +
         | Connection_error of string

     

       14
       14
       +
       

     

       15
       15
       +
       val pp_error : Format.formatter -> error -> unit

     

       16
       16
       +
       

     

       17
       17
       +
       (** Search result types *)

     

       18
       18
       +
       type search_result = {

     

       19
       19
       +
         id: string;

     

       20
       20
       +
         title: string;

     

       21
       21
       +
         content: string;

     

       22
       22
       +
         score: float;

     

       23
       23
       +
         collection: string;

     

       24
       24
       +
         highlights: (string * string list) list;

     

       25
       25
       +
         document: Ezjsonm.value;  (* Store raw document for flexible field access *)

     

       26
       26
       +
       }

     

       27
       27
       +
       

     

       28
       28
       +
       type search_response = {

     

       29
       29
       +
         hits: search_result list;

     

       30
       30
       +
         total: int;

     

       31
       31
       +
         query_time: float;

     

       32
       32
       +
       }

     

       33
       33
       +
       

     

       34
       34
       +
       (** Multisearch result types *)

     

       35
       35
       +
       type multisearch_response = {

     

       36
       36
       +
         results: search_response list;

     

       37
       37
       +
       }

     

       38
       38
       +
       

     

       39
       39
       +
       (** Search a single collection *)

     

       40
       40
       +
       val search_collection :

     

       41
       41
       +
         sw:Eio.Switch.t ->

     

       42
       42
       +
         env:< clock: [> float Eio.Time.clock_ty ] Eio.Resource.t; net: [> [> `Generic ] Eio.Net.ty ] Eio.Resource.t; .. > ->

     

       43
       43
       +
         config ->

     

       44
       44
       +
         string ->

     

       45
       45
       +
         string ->

     

       46
       46
       +
         ?limit:int ->

     

       47
       47
       +
         ?offset:int ->

     

       48
       48
       +
         unit ->

     

       49
       49
       +
         (search_response, error) result

     

       50
       50
       +
       

     

       51
       51
       +
       (** Perform multisearch across all collections *)

     

       52
       52
       +
       val multisearch :

     

       53
       53
       +
         sw:Eio.Switch.t ->

     

       54
       54
       +
         env:< clock: [> float Eio.Time.clock_ty ] Eio.Resource.t; net: [> [> `Generic ] Eio.Net.ty ] Eio.Resource.t; .. > ->

     

       55
       55
       +
         config ->

     

       56
       56
       +
         string ->

     

       57
       57
       +
         ?limit:int ->

     

       58
       58
       +
         unit ->

     

       59
       59
       +
         (multisearch_response, error) result

     

       60
       60
       +
       

     

       61
       61
       +
       (** Combine multisearch results into single result set *)

     

       62
       62
       +
       val combine_multisearch_results :

     

       63
       63
       +
         multisearch_response ->

     

       64
       64
       +
         ?limit:int ->

     

       65
       65
       +
         ?offset:int ->

     

       66
       66
       +
         unit ->

     

       67
       67
       +
         search_response

     

       68
       68
       +
       

     

       69
       69
       +
       (** List all collections *)

     

       70
       70
       +
       val list_collections :

     

       71
       71
       +
         sw:Eio.Switch.t ->

     

       72
       72
       +
         env:< clock: [> float Eio.Time.clock_ty ] Eio.Resource.t; net: [> [> `Generic ] Eio.Net.ty ] Eio.Resource.t; .. > ->

     

       73
       73
       +
         config ->

     

       74
       74
       +
         ((string * int) list, error) result

     

       75
       75
       +
       

     

       76
       76
       +
       (** Pretty printer utilities *)

     

       77
       77
       +
       val extract_field_string : Ezjsonm.value -> string -> string

     

       78
       78
       +
       val extract_field_string_list : Ezjsonm.value -> string -> string list

     

       79
       79
       +
       val extract_field_bool : Ezjsonm.value -> string -> bool

     

       80
       80
       +
       val format_authors : string list -> string

     

       81
       81
       +
       val format_date : string -> string

     

       82
       82
       +
       val format_tags : string list -> string

     

       83
       83
       +
       

     

       84
       84
       +
       (** One-line pretty printer for search results *)

     

       85
       85
       +
       val pp_search_result_oneline : search_result -> 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 cohttp-lwt-unix ezjsonm http fpath))

     

       4
       4
       +
         (libraries astring eio requests ezjsonm http fpath uri))

+66 -68

stack/zotero-translation/zotero_translation.ml

···

       1
       1
        
       (** Resolve a DOI from a Zotero translation server *)

     

       2
       2
        
       

     

       3
       3
       -
       module C = Cohttp

     

       4
       4
       -
       module CL = Cohttp_lwt

     

       5
       5
       -
       module CLU = Cohttp_lwt_unix.Client

     

       6
       3
        
       module J = Ezjsonm

     

       7
       4
        
       

     

       8
       5
        
       (* From the ZTS source code:  https://github.com/zotero/translation-server/blob/master/src/formats.js

     
···

       102
       99
        
         | true -> Uri.of_string (base_uri ^ "import")

     

       103
       100
        
         | false -> Uri.of_string (base_uri ^ "/import")

     

       104
       101
        
       

     

       105
       105
       -
       open Lwt.Infix

     

       106
       106
       -
       

     

       107
       107
       -
       (* The Eio version has more in here, hence I'm just keeping this around. *)

     

       108
       108
       -
       type t = {

     

       102
       102
       +
       type ('clock, 'net) t = {

     

       109
       103
        
         base_uri: string;

     

       104
       104
       +
         requests_session: ('clock, 'net) Requests.t;

     

       110
       105
        
       }

     

       111
       106
        
       

     

       112
       112
       -
       let v base_uri = { base_uri }

     

       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

     

       112
       112
       +
         { base_uri; requests_session }

     

       113
       113
        
       

     

       114
       114
       -
       let resolve_doi { base_uri } doi =

     

       115
       115
       -
         let body = "https://doi.org/" ^ doi in

     

       116
       116
       -
         let doi_body = CL.Body.of_string body in

     

       117
       117
       -
         let headers = C.Header.init_with "content-type" "text/plain" in

     

       114
       114
       +
       let v _base_uri =

     

       115
       115
       +
         failwith "Zotero_translation.v is deprecated. Use Zotero_translation.create ~sw ~env base_uri instead"

     

       116
       116
       +
       

     

       117
       117
       +
       let resolve_doi { base_uri; requests_session } doi =

     

       118
       118
       +
         let body_str = "https://doi.org/" ^ doi in

     

       118
       119
        
         let uri = web_endp base_uri in

     

       119
       119
       -
         CLU.call ~headers ~body:doi_body `POST uri >>= fun (resp, body) ->

     

       120
       120
       -
         let status = C.Response.status resp in

     

       121
       121
       -
         body |> Cohttp_lwt.Body.to_string >>= fun body ->

     

       122
       122
       -
         if status = `OK then begin

     

       120
       120
       +
         let body = Requests.Body.text body_str in

     

       121
       121
       +
         let response = Requests.post requests_session ~body (Uri.to_string uri) in

     

       122
       122
       +
         let status = Requests.Response.status_code response in

     

       123
       123
       +
         let body = Requests.Response.body response |> Eio.Flow.read_all in

     

       124
       124
       +
         if status = 200 then begin

     

       123
       125
        
           try

     

       124
       126
        
             let doi_json = J.from_string body in

     

       125
       125
       -
             Lwt.return_ok doi_json

     

       126
       126
       -
           with exn -> Lwt.return_error (`Msg (Printexc.to_string exn))

     

       127
       127
       +
             Ok doi_json

     

       128
       128
       +
           with exn -> Error (`Msg (Printexc.to_string exn))

     

       127
       129
        
         end else

     

       128
       128
       -
           Lwt.return_error (`Msg (Format.asprintf "Unexpected HTTP status: %a for %s" Http.Status.pp status body))

     

       130
       130
       +
           Error (`Msg (Format.asprintf "Unexpected HTTP status: %d for %s" status body))

     

       129
       131
        
       

     

       130
       130
       -
       let resolve_url { base_uri } url =

     

       131
       131
       -
         let url_body = CL.Body.of_string url in

     

       132
       132
       -
         let headers = C.Header.init_with "content-type" "text/plain" in

     

       132
       132
       +
       let resolve_url { base_uri; requests_session } url =

     

       133
       133
       +
         let body_str = url in

     

       133
       134
        
         let uri = web_endp base_uri in

     

       134
       134
       -
         CLU.call ~headers ~body:url_body `POST uri >>= fun (resp, body) ->

     

       135
       135
       -
         let status = C.Response.status resp in

     

       136
       136
       -
         body |> Cohttp_lwt.Body.to_string >>= fun body ->

     

       137
       137
       -
         if status = `OK then begin

     

       135
       135
       +
         let body = Requests.Body.text body_str in

     

       136
       136
       +
         let response = Requests.post requests_session ~body (Uri.to_string uri) in

     

       137
       137
       +
         let status = Requests.Response.status_code response in

     

       138
       138
       +
         let body = Requests.Response.body response |> Eio.Flow.read_all in

     

       139
       139
       +
         if status = 200 then begin

     

       138
       140
        
           try

     

       139
       141
        
             let url_json = J.from_string body in

     

       140
       140
       -
             Lwt.return_ok url_json

     

       141
       141
       -
           with exn -> Lwt.return_error (`Msg (Printexc.to_string exn))

     

       142
       142
       +
             Ok url_json

     

       143
       143
       +
           with exn -> Error (`Msg (Printexc.to_string exn))

     

       142
       144
        
         end else

     

       143
       143
       -
           Lwt.return_error (`Msg (Format.asprintf "Unexpected HTTP status: %a for %s" Http.Status.pp status body))

     

       145
       145
       +
           Error (`Msg (Format.asprintf "Unexpected HTTP status: %d for %s" status body))

     

       144
       146
        
       

     

       145
       145
       -
       let search_id { base_uri} doi =

     

       146
       146
       -
         let body = "https://doi.org/" ^ doi in

     

       147
       147
       -
         let doi_body = CL.Body.of_string body in

     

       148
       148
       -
         let headers = C.Header.init_with "content-type" "text/plain" in

     

       147
       147
       +
       let search_id { base_uri; requests_session } doi =

     

       148
       148
       +
         let body_str = "https://doi.org/" ^ doi in

     

       149
       149
        
         let uri = search_endp base_uri in

     

       150
       150
       -
         CLU.call ~headers ~body:doi_body `POST uri >>= fun (resp, body) ->

     

       151
       151
       -
         let status = C.Response.status resp in

     

       152
       152
       -
         body |> Cohttp_lwt.Body.to_string >>= fun body ->

     

       153
       153
       -
         if status = `OK then begin

     

       150
       150
       +
         let body = Requests.Body.text body_str in

     

       151
       151
       +
         let response = Requests.post requests_session ~body (Uri.to_string uri) in

     

       152
       152
       +
         let status = Requests.Response.status_code response in

     

       153
       153
       +
         let body = Requests.Response.body response |> Eio.Flow.read_all in

     

       154
       154
       +
         if status = 200 then begin

     

       154
       155
        
             try

     

       155
       156
        
               let doi_json = J.from_string body in

     

       156
       156
       -
               Lwt.return_ok doi_json

     

       157
       157
       -
             with exn -> Lwt.return_error (`Msg (Printexc.to_string exn))

     

       157
       157
       +
               Ok doi_json

     

       158
       158
       +
             with exn -> Error (`Msg (Printexc.to_string exn))

     

       158
       159
        
         end else

     

       159
       159
       -
           Lwt.return_error (`Msg (Format.asprintf "Unexpected HTTP status: %a for %s" Http.Status.pp status body))

     

       160
       160
       +
           Error (`Msg (Format.asprintf "Unexpected HTTP status: %d for %s" status body))

     

       160
       161
        
       

     

       161
       161
       -
       let export {base_uri} format api =

     

       162
       162
       -
         let body = CL.Body.of_string (J.to_string api) in

     

       163
       163
       -
         let headers = C.Header.init_with "content-type" "application/json" in

     

       162
       162
       +
       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
       -
         CLU.call ~headers ~body `POST uri >>= fun (resp, body) ->

     

       166
       166
       -
         let status = C.Response.status resp in

     

       167
       167
       -
         body |> Cohttp_lwt.Body.to_string >>= fun body ->

     

       168
       168
       -
         if status = `OK then begin

     

       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

     

       169
       170
        
           try

     

       170
       171
        
             match format with

     

       171
       171
       -
             | Bibtex -> Lwt.return_ok (Astring.String.trim body)

     

       172
       172
       -
             | _ -> Lwt.return_ok body

     

       173
       173
       -
           with exn -> Lwt.return_error (`Msg (Printexc.to_string exn))

     

       172
       172
       +
             | Bibtex -> Ok (Astring.String.trim body)

     

       173
       173
       +
             | _ -> Ok body

     

       174
       174
       +
           with exn -> Error (`Msg (Printexc.to_string exn))

     

       174
       175
        
         end else

     

       175
       175
       -
           Lwt.return_error (`Msg (Format.asprintf "Unexpected HTTP status: %a for %s" Http.Status.pp status body))

     

       176
       176
       +
           Error (`Msg (Format.asprintf "Unexpected HTTP status: %d for %s" status body))

     

       176
       177
        
       

     

       177
       178
        
       let unescape_hex s =

     

       178
       179
        
         let buf = Buffer.create (String.length s) in

     
···

       201
       202
        
         | Error e ->

     

       202
       203
        
             prerr_endline bib;

     

       203
       204
        
             Fmt.epr "%a\n%!" Bibtex.pp_error e;

     

       204
       204
       -
             Lwt.fail_with "bib parse err TODO"

     

       205
       205
       +
             failwith "bib parse err TODO"

     

       205
       206
        
         | Ok [bib] ->

     

       206
       207
        
             let f = Bibtex.fields bib |> Bibtex.SM.bindings |> List.map (fun (k,v) -> k, (unescape_bibtex v)) in

     

       207
       208
        
             let ty = match Bibtex.type' bib with "inbook" -> "book" | x -> x in

     

       208
       209
        
             let v = List.fold_left (fun acc (k,v) -> (k,(`String v))::acc) ["bibtype",`String ty] f in

     

       209
       209
       -
             Lwt.return v

     

       210
       210
       -
         | Ok _ -> Lwt.fail_with "one bib at a time plz"

     

       210
       210
       +
             v

     

       211
       211
       +
         | Ok _ -> failwith "one bib at a time plz"

     

       211
       212
        
       

     

       212
       213
        
       let bib_of_doi zt doi =

     

       213
       214
        
         prerr_endline ("Fetching " ^ doi);

     

       214
       214
       -
         let v = resolve_doi zt doi >>= function

     

       215
       215
       -
         | Ok r ->

     

       216
       216
       -
            Lwt.return r

     

       215
       215
       +
         let v = match resolve_doi zt doi with

     

       216
       216
       +
         | Ok r -> r

     

       217
       217
        
         | Error (`Msg _) ->

     

       218
       218
        
            Printf.eprintf "%s failed on /web, trying to /search\n%!" doi;

     

       219
       219
       -
            search_id zt doi >>= function

     

       220
       220
       -
            | Error (`Msg e) -> Lwt.fail_with e

     

       221
       221
       -
            | Ok r ->

     

       222
       222
       -
               Lwt.return r

     

       219
       219
       +
            match search_id zt doi with

     

       220
       220
       +
            | Error (`Msg e) -> failwith e

     

       221
       221
       +
            | Ok r -> r

     

       223
       222
        
         in

     

       224
       224
       -
         v >>= fun v ->

     

       225
       225
       -
         export zt Bibtex v >>= function

     

       226
       226
       -
         | Error (`Msg e) -> Lwt.fail_with e

     

       223
       223
       +
         match export zt Bibtex v with

     

       224
       224
       +
         | Error (`Msg e) -> failwith e

     

       227
       225
        
         | Ok r ->

     

       228
       226
        
             print_endline r;

     

       229
       229
       -
             Lwt.return r

     

       227
       227
       +
             r

     

       230
       228
        
       

     

       231
       229
        
       let split_authors keys =

     

       232
       230
        
         let authors =

     
···

       270
       268
        
         fun bib -> J.update y ["bib"] (Some (`String bib))

     

       271
       269
        
       

     

       272
       270
        
       let json_of_doi zt ~slug doi =

     

       273
       273
       -
         bib_of_doi zt doi >>= fun x ->

     

       274
       274
       -
         fields_of_bib x >>= fun x ->

     

       275
       275
       -
         Lwt.return (split_authors x |> add_bibtex ~slug)

     

       271
       271
       +
         let x = bib_of_doi zt doi in

     

       272
       272
       +
         let x = fields_of_bib x in

     

       273
       273
       +
         split_authors x |> add_bibtex ~slug

+25 -7

stack/zotero-translation/zotero_translation.mli

···

       1
       1
        
       (** {1 Interface to the Zotero Translation Server} *)

     

       2
       2
        
       

     

       3
       3
       -
       type t

     

       3
       3
       +
       type ('clock, 'net) t

     

       4
       4
        
       

     

       5
       5
        
       type format =

     

       6
       6
        
         | Bibtex

     
···

       24
       24
        
       val format_to_string: format -> string

     

       25
       25
        
       val format_of_string: string -> format option

     

       26
       26
        
       

     

       27
       27
       -
       val v :  string -> t

     

       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. *)

     

       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 ->

     

       36
       36
       +
         string -> ('clock Eio.Resource.t, 'net Eio.Resource.t) t

     

       28
       37
        
       

     

       29
       29
       -
       val resolve_doi: t -> string -> ([>Ezjsonm.t], [>`Msg of string]) Lwt_result.t

     

       38
       38
       +
       (** Deprecated: use [create] instead *)

     

       39
       39
       +
       val v : string -> (_, _) t

     

       40
       40
       +
         [@@deprecated "Use create ~sw ~env base_uri instead"]

     

       30
       41
        
       

     

       31
       31
       -
       val resolve_url: t -> string -> ([>Ezjsonm.t], [>`Msg of string]) Lwt_result.t

     

       42
       42
       +
       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

     

       32
       44
        
       

     

       33
       33
       -
       val search_id: t -> string -> ([>Ezjsonm.t], [>`Msg of string]) Lwt_result.t

     

       45
       45
       +
       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

     

       34
       47
        
       

     

       35
       35
       -
       val export: t -> format -> Ezjsonm.t -> (string, [>`Msg of string]) Lwt_result.t

     

       48
       48
       +
       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

     

       36
       50
        
       

     

       37
       37
       -
       val json_of_doi : t -> slug:string -> string -> Ezjsonm.value Lwt.t

     

       51
       51
       +
       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

     

       53
       53
       +
       

     

       54
       54
       +
       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