this repo has no description
more
+34
-26
+1
-1
requests/lib/dune
+1
-1
requests/lib/dune
+21
-16
requests/lib/requests.ml
+21
-16
requests/lib/requests.ml
···
99
99
| Bearer { token } ->
100
100
Cohttp.Header.add headers "Authorization" (Printf.sprintf "Bearer %s" token)
101
101
| OAuth1 { consumer_key; consumer_secret; token; token_secret; signature_method } ->
102
-
(* TODO FIXME use mirage-random properly here instead of timestamp/nonce *)
103
102
let timestamp = Printf.sprintf "%.0f" (Unix.gettimeofday ()) in
104
-
let nonce = Printf.sprintf "%016x%016x" (Random.bits ()) (Random.bits ()) in
103
+
(* Generate cryptographically secure nonce using mirage-crypto-rng *)
104
+
let nonce_bytes = Mirage_crypto_rng.generate 16 in
105
+
let nonce = Base64.encode_string (Cstruct.to_string nonce_bytes) in
105
106
106
107
let signature_method_str = match signature_method with
107
108
| `HMAC_SHA1 -> "HMAC-SHA1"
···
324
325
let jittered = base_time +. Random.float t.backoff.jitter in
325
326
min jittered t.backoff.max
326
327
327
-
let sleep ~sw:_ t response =
328
+
let sleep ~clock t response =
328
329
let backoff_time =
329
330
match t.respect_retry_after, response with
330
331
| true, Some resp ->
···
335
336
| _ -> get_backoff_time t
336
337
in
337
338
if backoff_time > 0.0 then
338
-
Unix.sleepf backoff_time
339
+
Eio.Time.sleep clock backoff_time
339
340
end
340
341
341
342
module Config = struct
···
406
407
Tls.Config.client ~authenticator ()
407
408
end
408
409
410
+
type clock = Clock : _ Eio.Time.clock -> clock
411
+
409
412
type 'a t = {
410
413
net : 'a Net.t;
414
+
clock : clock;
411
415
tls_config : Tls.config;
412
416
default_headers : Cohttp.Header.t;
413
417
} constraint 'a = [> `Generic] Net.ty
414
418
415
-
let create ?(tls_config=Tls.default ()) ?(default_headers=Cohttp.Header.init ()) net =
416
-
{ net; tls_config; default_headers }
419
+
let create ?(tls_config=Tls.default ()) ?(default_headers=Cohttp.Header.init ()) ~clock net =
420
+
{ net; clock = Clock clock; tls_config; default_headers }
417
421
418
422
419
423
let make_client net tls_config =
···
491
495
Uri.pp uri (retry_state.Retry.retry_count + 1) retry_state.Retry.total);
492
496
let retry_state = Retry.increment retry_state ~method_:meth ~url:uri
493
497
~response:result () in
494
-
Retry.sleep ~sw retry_state (Some result);
498
+
(match t.clock with Clock c -> Retry.sleep ~clock:c retry_state (Some result));
495
499
request_with_retries ~sw t ~config ?body ~meth uri retry_state
496
500
end else
497
501
raise (Request_error (Http_error {
···
512
516
(retry_state.Retry.retry_count + 1) retry_state.Retry.total);
513
517
let retry_state = Retry.increment retry_state ~method_:meth ~url:uri
514
518
~error:(Request_error (Connection_error (Printexc.to_string e))) () in
515
-
Retry.sleep ~sw retry_state None;
519
+
(match t.clock with Clock c -> Retry.sleep ~clock:c retry_state None);
516
520
request_with_retries ~sw t ~config ?body ~meth uri retry_state
517
521
end else
518
522
raise (Request_error (Connection_error (Printexc.to_string e)))
···
603
607
604
608
type 'a t = 'a session constraint 'a = [> `Generic] Net.ty
605
609
606
-
let create ?tls_config ?default_headers net =
607
-
{ client = create ?tls_config ?default_headers net;
610
+
let create ?tls_config ?default_headers ~clock net =
611
+
{ client = create ?tls_config ?default_headers ~clock net;
608
612
cookies = ref [] }
609
613
610
614
let parse_cookie_header cookie_str =
···
1026
1030
type 'a pool_manager = {
1027
1031
sw : Switch.t;
1028
1032
net : 'a Net.t;
1033
+
clock : clock;
1029
1034
pools : (string, ConnectionPool.t) Hashtbl.t;
1030
1035
num_pools : int;
1031
1036
headers : Cohttp.Header.t;
···
1038
1043
1039
1044
type 'a t = 'a pool_manager constraint 'a = [> `Generic] Net.ty
1040
1045
1041
-
let create ~sw ?(num_pools=10) ?(headers=Cohttp.Header.init ())
1046
+
let create ~sw ~clock ?(num_pools=10) ?(headers=Cohttp.Header.init ())
1042
1047
?(retries=Retry.default) ?(timeout=Timeout.default)
1043
1048
?(pool_config=ConnectionPool.default_config) ?tls_config ?cache net =
1044
1049
let cache = Option.map Cache.create cache in
1045
-
{ sw; net; pools = Hashtbl.create num_pools; num_pools;
1050
+
{ sw; net; clock = Clock clock; pools = Hashtbl.create num_pools; num_pools;
1046
1051
headers; retries; timeout; pool_config; tls_config; cache }
1047
1052
1048
1053
let get_pool t ~scheme ~host ~port =
···
1096
1101
| None -> headers
1097
1102
in
1098
1103
1099
-
let create_client = fun ?tls_config ?default_headers net ->
1100
-
{ net; tls_config = Option.value ~default:(Tls.default ()) tls_config;
1104
+
let create_client = fun ?tls_config ?default_headers ~clock net ->
1105
+
{ net; clock; tls_config = Option.value ~default:(Tls.default ()) tls_config;
1101
1106
default_headers = Option.value ~default:(Cohttp.Header.init ()) default_headers }
1102
1107
in
1103
-
let req_client = create_client ?tls_config:t.tls_config ~default_headers:t.headers t.net in
1108
+
let req_client = create_client ?tls_config:t.tls_config ~default_headers:t.headers ~clock:t.clock t.net in
1104
1109
let config = Config.create ~headers ~follow_redirects:redirect () in
1105
1110
1106
1111
(* Wrap request with timeout if specified *)
···
1149
1154
| Result.Error `Timeout ->
1150
1155
if attempt < retries.Retry.total then (
1151
1156
Log.info (fun m -> m "Request timeout, retry %d/%d" (attempt + 1) retries.Retry.total);
1152
-
Unix.sleepf 1.0;
1157
+
(match t.clock with Clock c -> Eio.Time.sleep c 1.0);
1153
1158
execute_with_retries (attempt + 1)
1154
1159
) else (
1155
1160
ConnectionPool.put_connection pool conn;
+4
-1
requests/lib/requests.mli
+4
-1
requests/lib/requests.mli
···
138
138
val create :
139
139
?tls_config:Tls.config ->
140
140
?default_headers:Cohttp.Header.t ->
141
+
clock:_ Eio.Time.clock ->
141
142
'a Net.t ->
142
143
'a t
143
144
···
246
247
val create :
247
248
?tls_config:Tls.config ->
248
249
?default_headers:Cohttp.Header.t ->
250
+
clock:_ Eio.Time.clock ->
249
251
'a Net.t ->
250
252
'a t
251
253
···
361
363
val increment : t -> method_:meth -> url:Uri.t -> ?response:Response.t -> ?error:exn -> unit -> t
362
364
val is_retry : t -> method_:meth -> status_code:int -> bool
363
365
val get_backoff_time : t -> float
364
-
val sleep : sw:Switch.t -> t -> Response.t option -> unit
366
+
val sleep : clock:_ Eio.Time.clock -> t -> Response.t option -> unit
365
367
end
366
368
367
369
(** Advanced timeout configuration *)
···
425
427
426
428
val create :
427
429
sw:Switch.t ->
430
+
clock:_ Eio.Time.clock ->
428
431
?num_pools:int ->
429
432
?headers:Cohttp.Header.t ->
430
433
?retries:Retry.t ->
+8
-8
requests/test/test_requests.ml
+8
-8
requests/test/test_requests.ml
···
2
2
3
3
let test_basic_get env =
4
4
Switch.run @@ fun sw ->
5
-
let client = Requests.create env#net in
5
+
let client = Requests.create ~clock:env#clock env#net in
6
6
7
7
(* Test simple GET request *)
8
8
let uri = Uri.of_string "https://api.github.com" in
···
16
16
17
17
let test_json_api env =
18
18
Switch.run @@ fun sw ->
19
-
let client = Requests.create env#net in
19
+
let client = Requests.create ~clock:env#clock env#net in
20
20
21
21
(* Test JSON API *)
22
22
let uri = Uri.of_string "https://api.github.com/users/ocaml" in
···
29
29
30
30
let test_custom_headers env =
31
31
Switch.run @@ fun sw ->
32
-
let client = Requests.create env#net in
32
+
let client = Requests.create ~clock:env#clock env#net in
33
33
34
34
(* Test with custom headers *)
35
35
let uri = Uri.of_string "https://api.github.com" in
···
44
44
45
45
let test_post_json env =
46
46
Switch.run @@ fun sw ->
47
-
let client = Requests.create env#net in
47
+
let client = Requests.create ~clock:env#clock env#net in
48
48
49
49
(* Test POST with JSON (to httpbin echo service) *)
50
50
let uri = Uri.of_string "https://httpbin.org/post" in
···
64
64
65
65
let test_session_cookies env =
66
66
Switch.run @@ fun sw ->
67
-
let session = Requests.Session.create env#net in
67
+
let session = Requests.Session.create ~clock:env#clock env#net in
68
68
69
69
(* Test session with cookies *)
70
70
let uri = Uri.of_string "https://httpbin.org/cookies/set?test=value" in
···
84
84
85
85
let test_error_handling env =
86
86
Switch.run @@ fun sw ->
87
-
let client = Requests.create env#net in
87
+
let client = Requests.create ~clock:env#clock env#net in
88
88
89
89
(* Test 404 error *)
90
90
let uri = Uri.of_string "https://api.github.com/users/this-user-definitely-does-not-exist-12345" in
···
101
101
Switch.run @@ fun sw ->
102
102
103
103
(* Test with default TLS config *)
104
-
let client1 = Requests.create ~tls_config:(Requests.Tls.default ()) env#net in
104
+
let client1 = Requests.create ~clock:env#clock ~tls_config:(Requests.Tls.default ()) env#net in
105
105
let uri = Uri.of_string "https://api.github.com" in
106
106
let response1 = Requests.get ~sw client1 uri in
107
107
assert (Requests.Response.is_success response1);
108
108
109
109
(* Test with custom CA certs *)
110
110
let auth = Result.get_ok (Ca_certs.authenticator ()) in
111
-
let client2 = Requests.create ~tls_config:(Requests.Tls.with_ca_certs auth) env#net in
111
+
let client2 = Requests.create ~clock:env#clock ~tls_config:(Requests.Tls.with_ca_certs auth) env#net in
112
112
let response2 = Requests.get ~sw client2 uri in
113
113
assert (Requests.Response.is_success response2)
114
114