Update to dream.1.0.0~alpha4 and cmdliner>=1.1.0

This commit is contained in:
Reynir Björnsson 2023-02-17 09:45:27 +01:00
parent 18e5babfde
commit 2c2a7a9038
3 changed files with 18 additions and 21 deletions

View file

@ -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))

View file

@ -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

View file

@ -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"