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.

Sign up for GitHub

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

Upgrade packages, replace mirage-crypto hashes with digestif #293

Merged
merged 3 commits into from
Feb 5, 2025
Merged

Upgrade packages, replace mirage-crypto hashes with digestif #293

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
e87f913
update dependencies, use digestif for md5 and sha1, update deprecatio…
mabiede Jan 23, 2025
1e69878
run formatter
mabiede Jan 23, 2025
3ac92a6
add to changelog
mabiede Feb 3, 2025
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
1 change: 0 additions & 1 deletion .ocamlformat
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,4 +1,3 @@
version = 0.19.0
profile = janestreet
parse-docstrings = true
wrap-comments = true
2 changes: 2 additions & 0 deletions CHANGES.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -11,10 +11,12 @@

- Fix Fullsplat behavior (routes with `**`)
- Undo splat reverse order. Now, the matches for `/*/*/*` with the url `/a/b/c` will return `["a"; "b"; "c"]`
- deprecated `Term` commands

## Changed

- Update various opium-testing apis to avoid raising warning 16
- replacing `mirage-crypto` with `digestif`, because `mirage-crypto` doesn't provide `md5` and `sha1` anymore

# 0.20.0

Expand Down
4 changes: 2 additions & 2 deletions README.md
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -195,10 +195,10 @@ $ dune build example/simple_middleware/main.ml
```

Here we also use the ability of Opium to generate a cmdliner term to run your
app. Run your executable with `--help` to see the options that are available to you.
app. Run your executable with `-h` to see the options that are available to you.
For example:

```
# run in debug mode on port 9000
$ dune exec example/simple_middleware/main.exe -- -p 9000 -d
$ dune exec dune build example/simple_middleware/main.exe -- -p 9000 -d
```
20 changes: 10 additions & 10 deletions benchmark/src/httpaf.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -47,11 +47,11 @@ let benchmark =
let error_handler ?request:_ error start_response =
let response_body = start_response Headers.empty in
(match error with
| `Exn exn ->
Body.write_string response_body (Printexc.to_string exn);
Body.write_string response_body "\n"
| #Status.standard as error ->
Body.write_string response_body (Status.default_reason_phrase error));
| `Exn exn ->
Body.write_string response_body (Printexc.to_string exn);
Body.write_string response_body "\n"
| #Status.standard as error ->
Body.write_string response_body (Status.default_reason_phrase error));
Body.close_writer response_body
;;

Expand All @@ -61,11 +61,11 @@ let () =
let request_handler _ = benchmark in
let error_handler _ = error_handler in
Lwt.async (fun () ->
Lwt_io.establish_server_with_client_socket
~backlog:11_000
listen_address
(Server.create_connection_handler ~request_handler ~error_handler)
>>= fun _server -> Lwt.return_unit);
Lwt_io.establish_server_with_client_socket
~backlog:11_000
listen_address
(Server.create_connection_handler ~request_handler ~error_handler)
>>= fun _server -> Lwt.return_unit);
let forever, _ = Lwt.wait () in
Lwt_main.run forever
;;
12 changes: 6 additions & 6 deletions dune-project
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -18,9 +18,9 @@
(package
(name rock)
(synopsis
"Minimalist framework to build extensible HTTP servers and clients")
"Minimalist framework to build extensible HTTP servers and clients")
(description
"Rock is a Unix indpendent API to build extensible HTTP servers and clients. It provides building blocks such as middlewares and handlers (a.k.a controllers).")
"Rock is a Unix indpendent API to build extensible HTTP servers and clients. It provides building blocks such as middlewares and handlers (a.k.a controllers).")
(depends
(ocaml
(>= 4.08))
Expand All @@ -37,7 +37,7 @@
(name opium)
(synopsis "OCaml web framework")
(description
"Opium is a web framework for OCaml that provides everything you need to build safe, fast and extensible web applications.")
"Opium is a web framework for OCaml that provides everything you need to build safe, fast and extensible web applications.")
(depends
(ocaml
(>= 4.08))
Expand All @@ -54,7 +54,7 @@
magic-mime
yojson
tyxml
mirage-crypto
digestif
(base64
(>= 3.0.0))
astring
Expand All @@ -71,7 +71,7 @@
(name opium-testing)
(synopsis "Testing library for Opium")
(description
"A library that provides helpers to easily test your Opium applications.")
"A library that provides helpers to easily test your Opium applications.")
(depends
(ocaml
(>= 4.08))
Expand All @@ -85,7 +85,7 @@
(name opium-graphql)
(synopsis "Run GraphQL servers with Opium")
(description
"This package allows you to execute Opium requests against GraphQL schemas built with `graphql`.")
"This package allows you to execute Opium requests against GraphQL schemas built with `graphql`.")
(depends
(ocaml
(>= 4.08))
Expand Down
140 changes: 70 additions & 70 deletions example/file_upload/main.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -32,76 +32,76 @@ let index_view ?(success = false) () =
layout
~title:"Opium file upload"
[ (if success
then
div
~a:[ a_class [ "mx-auto mt-16 max-w-lg rounded-md bg-green-50 p-4" ] ]
[ div
~a:[ a_class [ "flex" ] ]
[ div
~a:[ a_class [ "flex-shrink-0" ] ]
[ svg
~a:
[ Tyxml.Svg.a_class [ "h-5 w-5 text-green-400" ]
; Tyxml.Svg.a_viewBox (0., 0., 20., 20.)
; Tyxml.Svg.a_fill `CurrentColor
]
[ Tyxml.Svg.path
~a:
[ a_svg_custom "fill-rule" "evenodd"
; Tyxml.Svg.a_d
"M10 18a8 8 0 100-16 8 8 0 000 16zm3.707-9.293a1 1 0 \
00-1.414-1.414L9 10.586 7.707 9.293a1 1 0 00-1.414 \
1.414l2 2a1 1 0 001.414 0l4-4z"
; a_svg_custom "clip-rule" "evenodd"
]
[]
]
]
; div
~a:[ a_class [ "ml-3" ] ]
[ p
~a:[ a_class [ "text-sm leading-5 font-medium text-green-800" ] ]
[ txt "Successfully uploaded" ]
]
; div
~a:[ a_class [ "ml-auto pl-3" ] ]
[ div
~a:[ a_class [ "-mx-1.5 -my-1.5" ] ]
[ button
~a:
[ a_class
[ "inline-flex rounded-md p-1.5 text-green-500 \
hover:bg-green-100 focus:outline-none \
focus:bg-green-100 transition ease-in-out \
duration-150"
]
; a_aria "label" [ "Dismiss" ]
]
[ svg
~a:
[ Tyxml.Svg.a_class [ "h-5 w-5" ]
; Tyxml.Svg.a_viewBox (0., 0., 20., 20.)
; Tyxml.Svg.a_fill `CurrentColor
]
[ Tyxml.Svg.path
~a:
[ a_svg_custom "fill-rule" "evenodd"
; Tyxml.Svg.a_d
"M4.293 4.293a1 1 0 011.414 0L10 \
8.586l4.293-4.293a1 1 0 111.414 1.414L11.414 \
10l4.293 4.293a1 1 0 01-1.414 1.414L10 \
11.414l-4.293 4.293a1 1 0 01-1.414-1.414L8.586 \
10 4.293 5.707a1 1 0 010-1.414z"
; a_svg_custom "clip-rule" "evenodd"
]
[]
]
]
]
]
]
]
else div [])
then
div
~a:[ a_class [ "mx-auto mt-16 max-w-lg rounded-md bg-green-50 p-4" ] ]
[ div
~a:[ a_class [ "flex" ] ]
[ div
~a:[ a_class [ "flex-shrink-0" ] ]
[ svg
~a:
[ Tyxml.Svg.a_class [ "h-5 w-5 text-green-400" ]
; Tyxml.Svg.a_viewBox (0., 0., 20., 20.)
; Tyxml.Svg.a_fill `CurrentColor
]
[ Tyxml.Svg.path
~a:
[ a_svg_custom "fill-rule" "evenodd"
; Tyxml.Svg.a_d
"M10 18a8 8 0 100-16 8 8 0 000 16zm3.707-9.293a1 1 0 \
00-1.414-1.414L9 10.586 7.707 9.293a1 1 0 00-1.414 \
1.414l2 2a1 1 0 001.414 0l4-4z"
; a_svg_custom "clip-rule" "evenodd"
]
[]
]
]
; div
~a:[ a_class [ "ml-3" ] ]
[ p
~a:[ a_class [ "text-sm leading-5 font-medium text-green-800" ] ]
[ txt "Successfully uploaded" ]
]
; div
~a:[ a_class [ "ml-auto pl-3" ] ]
[ div
~a:[ a_class [ "-mx-1.5 -my-1.5" ] ]
[ button
~a:
[ a_class
[ "inline-flex rounded-md p-1.5 text-green-500 \
hover:bg-green-100 focus:outline-none \
focus:bg-green-100 transition ease-in-out \
duration-150"
]
; a_aria "label" [ "Dismiss" ]
]
[ svg
~a:
[ Tyxml.Svg.a_class [ "h-5 w-5" ]
; Tyxml.Svg.a_viewBox (0., 0., 20., 20.)
; Tyxml.Svg.a_fill `CurrentColor
]
[ Tyxml.Svg.path
~a:
[ a_svg_custom "fill-rule" "evenodd"
; Tyxml.Svg.a_d
"M4.293 4.293a1 1 0 011.414 0L10 \
8.586l4.293-4.293a1 1 0 111.414 1.414L11.414 \
10l4.293 4.293a1 1 0 01-1.414 1.414L10 \
11.414l-4.293 4.293a1 1 0 01-1.414-1.414L8.586 \
10 4.293 5.707a1 1 0 010-1.414z"
; a_svg_custom "clip-rule" "evenodd"
]
[]
]
]
]
]
]
]
else div [])
; form
~a:[ a_enctype "multipart/form-data"; a_action "/upload"; a_method `Post ]
[ div
Expand Down
7 changes: 5 additions & 2 deletions example/graphql/main.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -29,7 +29,10 @@ module Schema = struct

let user : (context, user option) Graphql_lwt.Schema.typ =
Schema.(
obj "user" ~doc:"A user in the system" ~fields:(fun _ ->
obj
"user"
~doc:"A user in the system"
~fields:
[ field
"id"
~doc:"Unique user identifier"
Expand All @@ -46,7 +49,7 @@ module Schema = struct
~typ:(non_null role)
~args:Arg.[]
~resolve:(fun _info p -> p.role)
]))
])
;;

let schema =
Expand Down
8 changes: 4 additions & 4 deletions example/rock_server/main.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -59,10 +59,10 @@ let run () =
fd
in
Lwt.async (fun () ->
let* _ =
Lwt_io.establish_server_with_client_socket listen_address connection_handler
in
Lwt.return_unit);
let* _ =
Lwt_io.establish_server_with_client_socket listen_address connection_handler
in
Lwt.return_unit);
let forever, _ = Lwt.wait () in
Lwt_main.run forever
;;
Expand Down
40 changes: 20 additions & 20 deletions opium-graphql/src/opium_graphql.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -107,23 +107,24 @@ let execute_request schema ctx req =
| Ok (query, variables, operation_name) ->
let+ result = execute_query ctx schema variables operation_name query in
(match result with
| Ok (`Response data) -> data |> basic_to_safe |> Opium.Response.of_json ~status:`OK
| Ok (`Stream stream) ->
Graphql_lwt.Schema.Io.Stream.close stream;
let body = "Subscriptions are only supported via websocket transport" in
Opium.Response.of_plain_text ~status:`Bad_request body
| Error err -> err |> basic_to_safe |> Opium.Response.of_json ~status:`Bad_request)
| Ok (`Response data) -> data |> basic_to_safe |> Opium.Response.of_json ~status:`OK
| Ok (`Stream stream) ->
Graphql_lwt.Schema.Io.Stream.close stream;
let body = "Subscriptions are only supported via websocket transport" in
Opium.Response.of_plain_text ~status:`Bad_request body
| Error err -> err |> basic_to_safe |> Opium.Response.of_json ~status:`Bad_request)
;;

let make_handler
: type a.
make_context:(Rock.Request.t -> a) -> a Graphql_lwt.Schema.schema -> Rock.Handler.t
: type a.
make_context:(Rock.Request.t -> a) -> a Graphql_lwt.Schema.schema -> Rock.Handler.t
=
fun ~make_context schema req ->
fun ~make_context schema req ->
match req.Opium.Request.meth with
| `GET ->
if Httpaf.Headers.get req.Opium.Request.headers "Connection" = Some "Upgrade"
&& Httpaf.Headers.get req.Opium.Request.headers "Upgrade" = Some "websocket"
if
Httpaf.Headers.get req.Opium.Request.headers "Connection" = Some "Upgrade"
&& Httpaf.Headers.get req.Opium.Request.headers "Upgrade" = Some "websocket"
then
(* TODO: Add subscription support when there is a good solution for websockets with
Httpaf *)
Expand All @@ -139,9 +140,8 @@ let make_handler
let graphiql_etag =
Asset.read "graphiql.html"
|> Option.get
|> Cstruct.of_string
|> Mirage_crypto.Hash.digest `MD5
|> Cstruct.to_string
|> Digestif.MD5.digest_string
|> Digestif.MD5.to_raw_string
|> Base64.encode_exn
;;

Expand All @@ -156,12 +156,12 @@ let make_graphiql_handler ~graphql_endpoint req =
~etag:graphiql_etag
~mime_type:"text/html; charset=utf-8"
(fun () ->
match Asset.read "graphiql.html" with
| None -> Lwt.return_error `Internal_server_error
| Some body ->
let regexp = Str.regexp_string "%%GRAPHQL_API%%" in
let body = Str.global_replace regexp graphql_endpoint body in
Lwt.return_ok (Opium.Body.of_string body))
match Asset.read "graphiql.html" with
| None -> Lwt.return_error `Internal_server_error
| Some body ->
let regexp = Str.regexp_string "%%GRAPHQL_API%%" in
let body = Str.global_replace regexp graphql_endpoint body in
Lwt.return_ok (Opium.Body.of_string body))
in
if accept_html
then h req
Expand Down
Loading
Loading