Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Chore: Fix CI for v5-backports #1094

Open
wants to merge 2 commits into
base: v5-backports
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion .github/workflows/workflow.yml
Original file line number Diff line number Diff line change
Expand Up @@ -16,7 +16,7 @@ jobs:
- macos-latest
- ubuntu-latest
ocaml-compiler:
- 4.14.x
- "5"

runs-on: ${{ matrix.os }}

Expand Down
2 changes: 1 addition & 1 deletion cohttp-async.opam
Original file line number Diff line number Diff line change
Expand Up @@ -34,7 +34,7 @@ depends: [
"cohttp" {= version}
"conduit-async" {>= "1.2.0"}
"magic-mime"
"mirage-crypto" {with-test}
"digestif" {with-test}
"logs"
"fmt" {>= "0.8.2"}
"sexplib0"
Expand Down
2 changes: 1 addition & 1 deletion cohttp-async/src/client.ml
Original file line number Diff line number Diff line change
Expand Up @@ -112,7 +112,7 @@ module Connection = struct
req oc
>>= fun () ->
read_response ic >>= fun (resp, body) ->
Ivar.fill res (resp, `Pipe body);
Ivar.fill_exn res (resp, `Pipe body);
(* block starting any more requests until the consumer has finished reading this request *)
Pipe.closed body)
|> don't_wait_for;
Expand Down
12 changes: 6 additions & 6 deletions cohttp-async/src/server.ml
Original file line number Diff line number Diff line change
Expand Up @@ -87,14 +87,14 @@ let handle_client handle_request sock rd wr =
Body.drain body >>| fun () -> Ivar.fill_if_empty finished ()
| `Response (req, body, (res, res_body)) ->
(* There are scenarios if a client leaves before consuming the full response,
we might have a reference to an async Pipe that doesn't get drained.
we might have a reference to an async Pipe that doesn't get drained.

Not draining or closing a pipe can lead to issues if its holding a resource like
a file handle as those resources will never be closed, leading to a leak.
Not draining or closing a pipe can lead to issues if its holding a resource like
a file handle as those resources will never be closed, leading to a leak.

Async writers have a promise that's fulfilled whenever they are closed,
so we can use it to schedule a close operation on the stream to ensure that we
don't leave a stream open if the underlying channels are closed. *)
Async writers have a promise that's fulfilled whenever they are closed,
so we can use it to schedule a close operation on the stream to ensure that we
don't leave a stream open if the underlying channels are closed. *)
(match res_body with
| `Empty | `String _ | `Strings _ -> ()
| `Pipe stream ->
Expand Down
3 changes: 2 additions & 1 deletion cohttp-async/test/test_async_integration.ml
Original file line number Diff line number Diff line change
Expand Up @@ -111,7 +111,8 @@ let ts =
("Pipe with empty strings", Pipe.of_list [ ""; ""; "" ], true);
]
in
Deferred.List.iter ~how:`Sequential tests ~f:(fun (msg, pipe, expected) ->
Deferred.List.iter ~how:`Sequential tests
~f:(fun (msg, pipe, expected) ->
is_empty (`Pipe pipe) >>| fun real ->
assert_equal ~msg expected real)
>>= fun () ->
Expand Down
12 changes: 2 additions & 10 deletions cohttp-lwt-unix/bin/dune
Original file line number Diff line number Diff line change
@@ -1,14 +1,6 @@
(executables
(names cohttp_curl_lwt cohttp_proxy_lwt cohttp_server_lwt)
(libraries
cohttp-lwt-unix
cohttp_server
logs
logs.lwt
logs.fmt
logs.cli
cmdliner
conduit-lwt
fmt.tty)
(libraries cohttp-lwt-unix cohttp_server logs logs.lwt logs.fmt logs.cli
cmdliner conduit-lwt fmt.tty)
(package cohttp-lwt-unix)
(public_names cohttp-curl-lwt cohttp-proxy-lwt cohttp-server-lwt))
2 changes: 1 addition & 1 deletion examples/async/dune
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
(executables
(names hello_world receive_post s3_cp)
(libraries mirage-crypto cohttp-async base async_kernel core_unix.command_unix))
(libraries digestif.c cohttp-async base async_kernel core_unix.command_unix))

(alias
(name runtest)
Expand Down
30 changes: 5 additions & 25 deletions examples/async/s3_cp.ml
Original file line number Diff line number Diff line change
Expand Up @@ -44,7 +44,6 @@ open Core
open Async
open Cohttp
open Cohttp_async

module Time = Time_float

let ksrt (k, _) (k', _) = String.compare k k'
Expand Down Expand Up @@ -83,18 +82,6 @@ module Compat = struct
let x = Char.to_int c in
(hexa.[x lsr 4], hexa.[x land 0xf])

let cstruct_to_hex_string cs =
let open Cstruct in
let n = cs.len in
let buf = Buffer.create (n * 2) in
for i = 0 to n - 1 do
let c = cs.buffer.{cs.off + i} in
let x, y = of_char c in
Buffer.add_char buf x;
Buffer.add_char buf y
done;
Buffer.contents buf

let encode_query_string uri =
(* Sort and encode query string.
Note that AWS wants null keys to have '=' for all keys.
Expand Down Expand Up @@ -170,8 +157,7 @@ module Auth = struct

let digest s =
(* string -> sha256 as a hex string *)
Mirage_crypto.Hash.(digest `SHA256 (Cstruct.of_string s))
|> Compat.cstruct_to_hex_string
Digestif.SHA256.(digest_string s |> to_hex)

let make_amz_headers ?body time =
(* Return x-amz-date and x-amz-sha256 headers *)
Expand Down Expand Up @@ -239,16 +225,12 @@ module Auth = struct
Printf.sprintf "AWS4-HMAC-SHA256\n%s\n%s\n%s" time_str scope_str hashed_req

let make_signing_key ?date ~region ~service ~secret_access_key () =
let mac k v =
Mirage_crypto.Hash.(mac `SHA256 ~key:k (Cstruct.of_string v))
in
let mac k v = Digestif.SHA256.(hmac_string ~key:k v |> to_raw_string) in
let date' =
match date with None -> Date.today ~zone:Time.Zone.utc | Some d -> d
in
let date_str = Date.to_string_iso8601_basic date' in
let date_key =
mac (Cstruct.of_string ("AWS4" ^ secret_access_key)) date_str
in
let date_key = mac ("AWS4" ^ secret_access_key) date_str in
let date_region_key = mac date_key (string_of_region region) in
let date_region_service_key =
mac date_region_key (string_of_service service)
Expand Down Expand Up @@ -278,14 +260,12 @@ module Auth = struct
(string_of_service service)
in
let signature =
Mirage_crypto.Hash.(
mac `SHA256 ~key:signing_key (Cstruct.of_string string_to_sign))
Digestif.SHA256.(hmac_string ~key:signing_key string_to_sign |> to_hex)
in
let auth_header =
Printf.sprintf
"AWS4-HMAC-SHA256 Credential=%s,SignedHeaders=%s,Signature=%s" creds
signed_headers
(Compat.cstruct_to_hex_string signature)
signed_headers signature
in
[ ("Authorization", auth_header) ]
end
Expand Down
Loading