Merge pull request #293 from mabiede/upgrade-packages

Upgrade packages, replace mirage-crypto hashes with digestif
rgrinberg · Feb 5, 2025 · 73b16f0 · 73b16f0
2 parents b72c5d2 + 3ac92a6
commit 73b16f0
Show file tree

Hide file tree

Showing 50 changed files with 654 additions and 618 deletions.
diff --git a/.ocamlformat b/.ocamlformat
@@ -1,4 +1,3 @@
-version = 0.19.0
 profile = janestreet
 parse-docstrings = true
 wrap-comments = true
diff --git a/CHANGES.md b/CHANGES.md
@@ -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
 

diff --git a/README.md b/README.md
@@ -190,10 +190,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:
 
 ```sh-session
 # 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
 ```
diff --git a/benchmark/src/httpaf.ml b/benchmark/src/httpaf.ml
@@ -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
 ;;
 
@@ -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
 ;;
diff --git a/dune-project b/dune-project
@@ -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))
@@ -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))
@@ -54,7 +54,7 @@
   magic-mime
   yojson
   tyxml
-  mirage-crypto
+  digestif
   (base64
    (>= 3.0.0))
   astring
@@ -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))
@@ -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))

diff --git a/example/file_upload/main.ml b/example/file_upload/main.ml
@@ -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

diff --git a/example/graphql/main.ml b/example/graphql/main.ml
@@ -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"
@@ -46,7 +49,7 @@ module Schema = struct
               ~typ:(non_null role)
               ~args:Arg.[]
               ~resolve:(fun _info p -> p.role)
-          ]))
+          ])
   ;;
 
   let schema =

diff --git a/example/rock_server/main.ml b/example/rock_server/main.ml
@@ -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
 ;;

diff --git a/opium-graphql/src/opium_graphql.ml b/opium-graphql/src/opium_graphql.ml
@@ -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 *)
@@ -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
 ;;
 
@@ -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