My agentic slop goes here. Not intended for anyone else!
1(** PeerTube API client implementation (Eio version) *)
2
3(** Type representing a PeerTube client *)
4type t = {
5 base_url: string;
6 requests_session: Requests.t;
7}
8
9(** Create a new PeerTube client *)
10let create ~requests_session ~base_url : t =
11 { base_url; requests_session }
12
13(** Type representing a PeerTube video *)
14type video = {
15 id: int;
16 uuid: string;
17 name: string;
18 description: string option;
19 url: string;
20 embed_path: string;
21 published_at: Ptime.t;
22 originally_published_at: Ptime.t option;
23 thumbnail_path: string option;
24 tags: string list option;
25 unknown: Jsont.json;
26}
27
28(** Type for PeerTube API response containing videos *)
29type video_response = {
30 total: int;
31 data: video list;
32 unknown: Jsont.json;
33}
34
35(** Accessor functions for video *)
36let video_id (v : video) = v.id
37let video_uuid (v : video) = v.uuid
38let video_name (v : video) = v.name
39let video_description (v : video) = v.description
40let video_url (v : video) = v.url
41let video_embed_path (v : video) = v.embed_path
42let video_published_at (v : video) = v.published_at
43let video_originally_published_at (v : video) = v.originally_published_at
44let video_thumbnail_path (v : video) = v.thumbnail_path
45let video_tags (v : video) = v.tags
46let video_unknown (v : video) = v.unknown
47
48(** Accessor functions for video_response *)
49let video_response_total (vr : video_response) = vr.total
50let video_response_data (vr : video_response) = vr.data
51let video_response_unknown (vr : video_response) = vr.unknown
52
53(** RFC3339 timestamp codec *)
54module Rfc3339 = struct
55 let parse s =
56 Ptime.of_rfc3339 s |> Result.to_option |> Option.map (fun (t, _, _) -> t)
57
58 let format t = Ptime.to_rfc3339 ~frac_s:6 ~tz_offset_s:0 t
59 let pp ppf t = Format.pp_print_string ppf (format t)
60
61 let jsont =
62 let kind = "RFC 3339 timestamp" in
63 let doc = "An RFC 3339 date-time string" in
64 let dec s =
65 match parse s with
66 | Some t -> t
67 | None ->
68 Jsont.Error.msgf Jsont.Meta.none "%s: invalid RFC 3339 timestamp: %S"
69 kind s
70 in
71 Jsont.map ~kind ~doc ~dec ~enc:format Jsont.string
72end
73
74(** Jsont codec for video *)
75let video_jsont : video Jsont.t =
76 let kind = "PeerTube Video" in
77 let doc = "A PeerTube video object" in
78
79 let make_video id uuid name description url embed_path published_at
80 originally_published_at thumbnail_path tags unknown : video =
81 { id; uuid; name; description; url; embed_path; published_at;
82 originally_published_at; thumbnail_path; tags; unknown }
83 in
84
85 Jsont.Object.map ~kind ~doc make_video
86 |> Jsont.Object.mem "id" Jsont.int ~enc:video_id
87 |> Jsont.Object.mem "uuid" Jsont.string ~enc:video_uuid
88 |> Jsont.Object.mem "name" Jsont.string ~enc:video_name
89 |> Jsont.Object.opt_mem "description" Jsont.string ~enc:video_description
90 |> Jsont.Object.mem "url" Jsont.string ~enc:video_url
91 |> Jsont.Object.mem "embedPath" Jsont.string ~enc:video_embed_path
92 |> Jsont.Object.mem "publishedAt" Rfc3339.jsont ~enc:video_published_at
93 |> Jsont.Object.opt_mem "originallyPublishedAt" Rfc3339.jsont ~enc:video_originally_published_at
94 |> Jsont.Object.opt_mem "thumbnailPath" Jsont.string ~enc:video_thumbnail_path
95 |> Jsont.Object.opt_mem "tags" (Jsont.list Jsont.string) ~enc:video_tags
96 |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:video_unknown
97 |> Jsont.Object.finish
98
99(** Jsont codec for video_response *)
100let video_response_jsont =
101 let kind = "PeerTube Video Response" in
102 let doc = "A PeerTube API response containing videos" in
103
104 let make_response total data unknown =
105 { total; data; unknown }
106 in
107
108 Jsont.Object.map ~kind ~doc make_response
109 |> Jsont.Object.mem "total" Jsont.int ~enc:video_response_total
110 |> Jsont.Object.mem "data" (Jsont.list video_jsont) ~enc:video_response_data
111 |> Jsont.Object.keep_unknown Jsont.json_mems ~enc:video_response_unknown
112 |> Jsont.Object.finish
113
114(** Parse a single video from JSON string *)
115let parse_video_string s =
116 match Jsont_bytesrw.decode_string' video_jsont s with
117 | Ok video -> video
118 | Error err -> failwith (Jsont.Error.to_string err)
119
120(** Parse a video response from JSON string *)
121let parse_video_response_string s =
122 match Jsont_bytesrw.decode_string' video_response_jsont s with
123 | Ok response -> response
124 | Error err -> failwith (Jsont.Error.to_string err)
125
126(** Fetch videos from a PeerTube instance channel with pagination support
127 @param count Number of videos to fetch per page
128 @param start Starting index for pagination (0-based)
129 @param client PeerTube client
130 @param channel Channel name to fetch videos from
131 @return The video response *)
132let fetch_channel_videos client ?(count=20) ?(start=0) channel =
133 let open Requests_json_api in
134 let url = Printf.sprintf "%s/api/v1/video-channels/%s/videos?count=%d&start=%d"
135 client.base_url channel count start in
136 get_json_exn client.requests_session url video_response_jsont
137
138(** Fetch all videos from a PeerTube instance channel using pagination
139 @param page_size Number of videos to fetch per page
140 @param max_pages Maximum number of pages to fetch (None for all pages)
141 @param client PeerTube client
142 @param channel Channel name to fetch videos from
143 @return All videos combined *)
144let fetch_all_channel_videos client ?(page_size=20) ?max_pages channel =
145 let rec fetch_pages start acc _total_count =
146 let response = fetch_channel_videos client ~count:page_size ~start channel in
147 let all_videos = acc @ response.data in
148
149 (* Determine if we need to fetch more pages *)
150 let fetched_count = start + List.length response.data in
151 let more_available = fetched_count < response.total in
152 let under_max_pages = match max_pages with
153 | None -> true
154 | Some max -> (start / page_size) + 1 < max
155 in
156
157 if more_available && under_max_pages then
158 fetch_pages fetched_count all_videos response.total
159 else
160 all_videos
161 in
162 fetch_pages 0 [] 0
163
164(** Fetch detailed information for a single video by UUID
165 @param client PeerTube client
166 @param uuid UUID of the video to fetch
167 @return The complete video details *)
168let fetch_video_details client uuid =
169 let open Requests_json_api in
170 let url = client.base_url / "api/v1/videos" / uuid in
171 get_json_exn client.requests_session url video_jsont
172
173(** Convert a PeerTube video to Bushel.Video.t compatible structure *)
174let to_bushel_video video =
175 let description = Option.value ~default:"" video.description in
176 let published_date = video.originally_published_at |> Option.value ~default:video.published_at in
177 (description, published_date, video.name, video.url, video.uuid, string_of_int video.id)
178
179(** Get the thumbnail URL for a video *)
180let thumbnail_url client video =
181 match video.thumbnail_path with
182 | Some path -> Some (client.base_url ^ path)
183 | None -> None
184
185(** Download a thumbnail to a file
186 @param client PeerTube client
187 @param fs The Eio filesystem capability
188 @param video The video to download the thumbnail for
189 @param output_path Path where to save the thumbnail
190 @return Ok () on success or Error with message *)
191let download_thumbnail client ~fs video output_path =
192 match thumbnail_url client video with
193 | None ->
194 Error (`Msg (Printf.sprintf "No thumbnail available for video %s" video.uuid))
195 | Some url ->
196 try
197 let open Requests_json_api in
198 match get_result client.requests_session url with
199 | Error (status_code, _body) ->
200 Error (`Msg (Printf.sprintf "HTTP error downloading thumbnail: %d" status_code))
201 | Ok body_str ->
202 try
203 let output_eio_path = Eio.Path.(fs / output_path) in
204 Eio.Path.save ~create:(`Or_truncate 0o644) output_eio_path body_str;
205 Ok ()
206 with exn ->
207 Error (`Msg (Printf.sprintf "Failed to write thumbnail: %s"
208 (Printexc.to_string exn)))
209 with exn ->
210 Error (`Msg (Printf.sprintf "Failed to download thumbnail: %s"
211 (Printexc.to_string exn)))