···

       
124
       
 
       
  let method_str = Method.to_string method_ in

     

       
125
       
 
       
  Log.info (fun m -> m "Making %s request to %s" method_str url);

     

       
126
       
 
       


     

       
127
       
-
       
  (* Parse URI *)

     

       
128
       
-
       
  let uri = Uri.of_string url in

     

       
129
       
-
       
  let host = match Uri.host uri with

     

       
130
       
-
       
    | Some h -> h

     

       
131
       
-
       
    | None -> failwith "URL must contain a host"

     

       
132
       
-
       
  in

     

       
133
       
-
       
  let port = match Uri.scheme uri, Uri.port uri with

     

       
134
       
-
       
    | Some "https", None -> 443

     

       
135
       
-
       
    | Some "https", Some p -> p

     

       
136
       
-
       
    | Some "http", None -> 80

     

       
137
       
-
       
    | Some "http", Some p -> p

     

       
138
       
-
       
    | _, Some p -> p

     

       
139
       
-
       
    | _ -> 80

     

       
140
       
-
       
  in

     

       
141
       
-
       


     

       
142
       
 
       
  (* Prepare headers *)

     

       
143
       
 
       
  let headers = match headers with

     

       
144
       
 
       
    | Some h -> h

     
···

       
161
       
 
       
    | None -> headers

     

       
162
       
 
       
  in

     

       
163
       
 
       


     

       
164
       
-
       
  (* Create endpoint for connection pool *)

     

       
165
       
-
       
  let endpoint = Conpool.Endpoint.make ~host ~port in

     

       
166
       
-
       


     

       
167
       
 
       
  (* Convert body to string for sending *)

     

       
168
       
 
       
  let request_body_str = match body with

     

       
169
       
 
       
    | None -> ""

     

       
170
       
 
       
    | Some b -> Body.Private.to_string b

     

       
171
       
 
       
  in

     

       
172
       
-
       


     

       
173
       
-
       
  (* Determine if we need TLS based on URL scheme and choose appropriate pool *)

     

       
174
       
-
       
  let is_https = match Uri.scheme uri with

     

       
175
       
-
       
    | Some "https" -> true

     

       
176
       
-
       
    | _ -> false

     

       
177
       
-
       
  in

     

       
178
       
-
       


     

       
179
       
-
       
  (* Choose the appropriate connection pool *)

     

       
180
       
-
       
  let pool = if is_https then client.https_pool else client.http_pool in

     

       
181
       
 
       


     

       
182
       
 
       
  (* Execute request with pooled connection *)

     

       
183
       
 
       
  let rec make_with_redirects url_to_fetch redirects_left =

     

       
184
       
 
       
    let uri_to_fetch = Uri.of_string url_to_fetch in

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
185
       
 
       


     

       
186
       
 
       
    let make_request_fn () =

     

       
187
       
 
       
      Conpool.with_connection pool endpoint (fun flow ->

     

···

       
124
       
 
       
  let method_str = Method.to_string method_ in

     

       
125
       
 
       
  Log.info (fun m -> m "Making %s request to %s" method_str url);

     

       
126
       
 
       


     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
127
       
 
       
  (* Prepare headers *)

     

       
128
       
 
       
  let headers = match headers with

     

       
129
       
 
       
    | Some h -> h

     
···

       
146
       
 
       
    | None -> headers

     

       
147
       
 
       
  in

     

       
148
       
 
       


     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
149
       
 
       
  (* Convert body to string for sending *)

     

       
150
       
 
       
  let request_body_str = match body with

     

       
151
       
 
       
    | None -> ""

     

       
152
       
 
       
    | Some b -> Body.Private.to_string b

     

       
153
       
 
       
  in

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
0
       
 
       

     

       
154
       
 
       


     

       
155
       
 
       
  (* Execute request with pooled connection *)

     

       
156
       
 
       
  let rec make_with_redirects url_to_fetch redirects_left =

     

       
157
       
 
       
    let uri_to_fetch = Uri.of_string url_to_fetch in

     

       
158
       
+
       


     

       
159
       
+
       
    (* Parse the redirect URL to get correct host and port *)

     

       
160
       
+
       
    let redirect_host = match Uri.host uri_to_fetch with

     

       
161
       
+
       
      | Some h -> h

     

       
162
       
+
       
      | None -> failwith "Redirect URL must contain a host"

     

       
163
       
+
       
    in

     

       
164
       
+
       
    let redirect_port = match Uri.scheme uri_to_fetch, Uri.port uri_to_fetch with

     

       
165
       
+
       
      | Some "https", None -> 443

     

       
166
       
+
       
      | Some "https", Some p -> p

     

       
167
       
+
       
      | Some "http", None -> 80

     

       
168
       
+
       
      | Some "http", Some p -> p

     

       
169
       
+
       
      | _, Some p -> p

     

       
170
       
+
       
      | _ -> 80

     

       
171
       
+
       
    in

     

       
172
       
+
       


     

       
173
       
+
       
    (* Create endpoint for this specific URL *)

     

       
174
       
+
       
    let endpoint = Conpool.Endpoint.make ~host:redirect_host ~port:redirect_port in

     

       
175
       
+
       


     

       
176
       
+
       
    (* Determine if we need TLS based on this URL's scheme *)

     

       
177
       
+
       
    let is_https = match Uri.scheme uri_to_fetch with

     

       
178
       
+
       
      | Some "https" -> true

     

       
179
       
+
       
      | _ -> false

     

       
180
       
+
       
    in

     

       
181
       
+
       


     

       
182
       
+
       
    (* Choose the appropriate connection pool for this URL *)

     

       
183
       
+
       
    let pool = if is_https then client.https_pool else client.http_pool in

     

       
184
       
 
       


     

       
185
       
 
       
    let make_request_fn () =

     

       
186
       
 
       
      Conpool.with_connection pool endpoint (fun flow ->