From 2c2a7a90383e2300a3d360c0e8488a63875883ff Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Reynir=20Bj=C3=B6rnsson?= Date: Fri, 17 Feb 2023 09:45:27 +0100 Subject: [PATCH] Update to dream.1.0.0~alpha4 and cmdliner>=1.1.0 --- bin/webauthn_demo.ml | 24 ++++++++++-------------- flash_message/flash_message.ml | 11 ++++++----- webauthn.opam | 4 ++-- 3 files changed, 18 insertions(+), 21 deletions(-) diff --git a/bin/webauthn_demo.ml b/bin/webauthn_demo.ml index 663c820..4c5243d 100644 --- a/bin/webauthn_demo.ml +++ b/bin/webauthn_demo.ml @@ -74,7 +74,7 @@ let add_routes t = in let registration_challenge req = - let user = Dream.param "user" req in + let user = Dream.param req "user" in let challenge, challenge_b64 = Webauthn.generate_challenge () in let userid, credentials = match find_username user with | None -> gen_data ~alphabet:Base64.uri_safe_alphabet 8, [] @@ -100,7 +100,7 @@ let add_routes t = in let register_finish req = - let userid = Dream.param "userid" req in + let userid = Dream.param req "userid" in Dream.body req >>= fun body -> Logs.debug (fun m -> m "received body: %s" body); match Hashtbl.find_opt registration_challenges userid with @@ -168,7 +168,7 @@ let add_routes t = in let authenticate req = - let userid = Dream.param "userid" req in + let userid = Dream.param req "userid" in match Hashtbl.find_opt users userid with | None -> Logs.warn (fun m -> m "no user found"); @@ -182,8 +182,8 @@ let add_routes t = in let authenticate_finish req = - let userid = Dream.param "userid" req - and b64_credential_id = Dream.param "credential_id" req + let userid = Dream.param req "userid" + and b64_credential_id = Dream.param req "credential_id" in match Base64.decode ~alphabet:Base64.uri_safe_alphabet ~pad:false b64_credential_id with | Error `Msg err -> @@ -262,18 +262,17 @@ let add_routes t = ] -let setup_app level port host origin https = +let setup_app level port host origin tls = let level = match level with None -> None | Some Logs.Debug -> Some `Debug | Some Info -> Some `Info | Some Warning -> Some `Warning | Some Error -> Some `Error | Some App -> None in Dream.initialize_log ?level (); match Webauthn.create origin with | Error e -> Logs.err (fun m -> m "failed to create webauthn: %s" e); exit 1 | Ok webauthn -> - Dream.run ~port ~interface:host ~https + Dream.run ~port ~interface:host ~tls @@ Dream.logger @@ Dream.memory_sessions @@ Flash_message.flash_messages @@ add_routes webauthn - @@ Dream.not_found open Cmdliner @@ -294,9 +293,6 @@ let tls = Arg.(value & flag & info [ "tls" ] ~doc) let () = - let term = Term.(pure setup_app $ Logs_cli.level () $ port $ host $ origin $ tls) in - let info = Term.info "Webauthn app" ~doc:"Webauthn app" ~man:[] in - match Term.eval (term, info) with - | `Ok () -> exit 0 - | `Error _ -> exit 1 - | _ -> exit 0 + let term = Term.(const setup_app $ Logs_cli.level () $ port $ host $ origin $ tls) in + let info = Cmd.info "Webauthn app" ~doc:"Webauthn app" ~man:[] in + exit (Cmd.eval (Cmd.v info term)) diff --git a/flash_message/flash_message.ml b/flash_message/flash_message.ml index c9a7630..277d77a 100644 --- a/flash_message/flash_message.ml +++ b/flash_message/flash_message.ml @@ -3,7 +3,7 @@ open Lwt.Syntax let five_minutes = 5. *. 60. -let storage = Dream.new_local ~name:"dream.flash_message" () +let storage = Dream.new_field ~name:"dream.flash_message" () let flash_cookie = "dream.flash_message" @@ -11,13 +11,14 @@ let flash_cookie = "dream.flash_message" let flash_messages inner_handler request = let outbox = ref [] in - let request = Dream.with_local storage outbox request in + Dream.set_field request storage outbox; let* response = inner_handler request in Lwt.return( let entries = List.rev !outbox in let content = List.fold_right (fun (x,y) a -> `String x :: `String y :: a) entries [] in let value = `List content |> Yojson.Basic.to_string in - Dream.set_cookie flash_cookie value request response ~max_age:five_minutes + Dream.set_cookie response request flash_cookie value ~max_age:five_minutes; + response ) @@ -33,7 +34,7 @@ let get_flash request = let unpack u = match u with | `String x -> x | _ -> failwith "Bad flash message content" in - let x = Dream.cookie flash_cookie request + let x = Dream.cookie request flash_cookie |>? fun value -> match Yojson.Basic.from_string value with | `List y -> Some (group @@ List.map unpack y) @@ -42,7 +43,7 @@ let get_flash request = let put_flash category message request = - let outbox = match Dream.local storage request with + let outbox = match Dream.field request storage with | Some outbox -> outbox | None -> let message = "Missing flash message middleware" in diff --git a/webauthn.opam b/webauthn.opam index db5202d..9aa9798 100644 --- a/webauthn.opam +++ b/webauthn.opam @@ -16,9 +16,9 @@ build: [ depends: [ "ocaml" {>= "4.08.0"} "dune" {>= "2.7"} - "dream" {dev & >= "1.0.0~alpha2"} + "dream" {dev & >= "1.0.0~alpha4"} "ppx_blob" {dev} - "cmdliner" {dev} + "cmdliner" {dev & >= "1.1.0"} "logs" {dev} "lwt" {dev} "yojson"