Update to dream.1.0.0~alpha4 and cmdliner>=1.1.0
This commit is contained in:
parent
18e5babfde
commit
2c2a7a9038
3 changed files with 18 additions and 21 deletions
|
@ -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))
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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"
|
||||
|
|
Loading…
Reference in a new issue