commit c05d4d96c03ce3cee7aef619d5bfdf138822a9dc · anil.recoil.org/slop

+29 -22

stack/requests/lib/one.ml

···

       10
        
         retry_backoff : float;

     

       11
        
         verify_tls : bool;

     

       12
        
         tls_config : Tls.Config.client option;

     

       13
       -
         pool : ('clock, 'net) Conpool.t;

     

       0
        
       
     

       14
        
       }

     

       15
        
       

     

       16
        
       let create

     
···

       46
        
           | None, false -> None

     

       47
        
         in

     

       48
        
       

     

       49
       -
         (* Create connection pool - plain TCP, we'll wrap with TLS per-request *)

     

       50
        
         let pool_config = Conpool.Config.make

     

       51
        
           ~max_connections_per_endpoint:max_connections_per_host

     

       52
        
           ~max_idle_time:connection_idle_timeout

     
···

       54
        
           ()

     

       55
        
         in

     

       56
        
       

     

       57
       -
         let pool = Conpool.create

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       58
        
           ~sw

     

       59
        
           ~net

     

       60
        
           ~clock

     

       0
        
       
     

       61
        
           ~config:pool_config

     

       62
        
           ()

     

       63
        
         in

     

       64
        
       

     

       65
       -
         Log.info (fun m -> m "Created HTTP client with connection pool (max_per_host=%d)"

     

       66
       -
           max_connections_per_host);

     

       67
        
       

     

       68
        
         {

     

       69
        
           clock;

     
···

       74
        
           retry_backoff;

     

       75
        
           verify_tls;

     

       76
        
           tls_config;

     

       77
       -
           pool;

     

       0
        
       
     

       78
        
         }

     

       79
        
       

     

       80
        
       let default ~sw ~clock ~net =

     
···

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

     

       154
        
         in

     

       155
        
       

     

       156
       -
         (* Determine if we need TLS based on URL scheme *)

     

       157
        
         let is_https = match Uri.scheme uri with

     

       158
        
           | Some "https" -> true

     

       159
        
           | _ -> false

     

       160
        
         in

     

       161
        
       

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       162
        
         (* Execute request with pooled connection *)

     

       163
        
         let rec make_with_redirects url_to_fetch redirects_left =

     

       164
        
           let uri_to_fetch = Uri.of_string url_to_fetch in

     

       165
        
       

     

       166
        
           let make_request_fn () =

     

       167
       -
             Conpool.with_connection client.pool endpoint (fun tcp_flow ->

     

       168
       -
               (* Wrap with TLS if HTTPS *)

     

       169
       -
               let flow : Eio.Flow.two_way_ty Eio.Resource.t = if is_https then

     

       170
       -
                 match client.tls_config with

     

       171
       -
                 | Some tls_cfg ->

     

       172
       -
                     let domain = Domain_name.of_string_exn host in

     

       173
       -
                     let servername = Domain_name.host_exn domain in

     

       174
       -
                     (Tls_eio.client_of_flow ~host:servername tls_cfg tcp_flow :> Eio.Flow.two_way_ty Eio.Resource.t)

     

       175
       -
                 | None ->

     

       176
       -
                     Log.warn (fun m -> m "HTTPS request but no TLS config available");

     

       177
       -
                     failwith "HTTPS requires TLS configuration"

     

       178
       -
               else

     

       179
       -
                 (tcp_flow :> Eio.Flow.two_way_ty Eio.Resource.t)

     

       180
       -
               in

     

       181
       -
       

     

       182
        
               (* Use our low-level HTTP client *)

     

       183
        
               Http_client.make_request ~method_:method_str ~uri:uri_to_fetch ~headers ~body_str:request_body_str flow

     

       184
        
             )

···

       10
        
         retry_backoff : float;

     

       11
        
         verify_tls : bool;

     

       12
        
         tls_config : Tls.Config.client option;

     

       13
       +
         http_pool : ('clock, 'net) Conpool.t;  (* For HTTP connections *)

     

       14
       +
         https_pool : ('clock, 'net) Conpool.t; (* For HTTPS connections *)

     

       15
        
       }

     

       16
        
       

     

       17
        
       let create

     
···

       47
        
           | None, false -> None

     

       48
        
         in

     

       49
        
       

     

       50
       +
         (* Create connection pools - one for HTTP, one for HTTPS *)

     

       51
        
         let pool_config = Conpool.Config.make

     

       52
        
           ~max_connections_per_endpoint:max_connections_per_host

     

       53
        
           ~max_idle_time:connection_idle_timeout

     
···

       55
        
           ()

     

       56
        
         in

     

       57
        
       

     

       58
       +
         (* HTTP pool - plain TCP connections *)

     

       59
       +
         let http_pool = Conpool.create

     

       60
       +
           ~sw

     

       61
       +
           ~net

     

       62
       +
           ~clock

     

       63
       +
           ~config:pool_config

     

       64
       +
           ()

     

       65
       +
         in

     

       66
       +
       

     

       67
       +
         (* HTTPS pool - TLS-wrapped connections *)

     

       68
       +
         let https_tls_config = Option.map (fun cfg ->

     

       69
       +
           Conpool.Tls_config.make ~config:cfg ()

     

       70
       +
         ) tls_config in

     

       71
       +
       

     

       72
       +
         let https_pool = Conpool.create

     

       73
        
           ~sw

     

       74
        
           ~net

     

       75
        
           ~clock

     

       76
       +
           ?tls:https_tls_config

     

       77
        
           ~config:pool_config

     

       78
        
           ()

     

       79
        
         in

     

       80
        
       

     

       81
       +
         Log.info (fun m -> m "Created HTTP client with connection pools (max_per_host=%d, TLS=%b)"

     

       82
       +
           max_connections_per_host (Option.is_some https_tls_config));

     

       83
        
       

     

       84
        
         {

     

       85
        
           clock;

     
···

       90
        
           retry_backoff;

     

       91
        
           verify_tls;

     

       92
        
           tls_config;

     

       93
       +
           http_pool;

     

       94
       +
           https_pool;

     

       95
        
         }

     

       96
        
       

     

       97
        
       let default ~sw ~clock ~net =

     
···

       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

     

       185
        
       

     

       186
        
           let make_request_fn () =

     

       187
       +
             Conpool.with_connection pool endpoint (fun flow ->

     

       188
       +
               (* Flow is already TLS-wrapped if from https_pool, plain TCP if from http_pool *)

     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       0
        
       
     

       189
        
               (* Use our low-level HTTP client *)

     

       190
        
               Http_client.make_request ~method_:method_str ~uri:uri_to_fetch ~headers ~body_str:request_body_str flow

     

       191
        
             )

+1 -1

stack/requests/test/test_requests.ml

···

       705
        
         end in

     

       706
        
         Test_server.start_server ~port test_env;

     

       707
        
       

     

       708
       -
         let client = Requests.One.create ~clock:env#clock ~net:env#net () in

     

       709
        
         let response = Requests.One.get ~sw ~client (base_url ^ "/echo") in

     

       710
        
       

     

       711
        
         Alcotest.(check int) "One module status" 200 (Requests.Response.status_code response)

···

       705
        
         end in

     

       706
        
         Test_server.start_server ~port test_env;

     

       707
        
       

     

       708
       +
         let client = Requests.One.create ~sw ~clock:env#clock ~net:env#net () in

     

       709
        
         let response = Requests.One.get ~sw ~client (base_url ^ "/echo") in

     

       710
        
       

     

       711
        
         Alcotest.(check int) "One module status" 200 (Requests.Response.status_code response)