~ syntax stuff
This commit is contained in:
parent
c1389c3906
commit
7f97d1017a
1 changed files with 30 additions and 23 deletions
|
|
@ -148,38 +148,45 @@ struct
|
|||
end
|
||||
|
||||
let tls certificate_ro key_ro =
|
||||
let ( >>= ) = Lwt_result.bind in
|
||||
Keys_ro.list key_ro Mirage_kv.Key.empty
|
||||
|> map_err_to_string Keys_ro.pp_error
|
||||
>>= fun keys ->
|
||||
let ( let*? ) = Lwt_result.bind in
|
||||
let ( let+? ) x f = Lwt_result.map f x in
|
||||
let*? keys =
|
||||
Keys_ro.list key_ro Mirage_kv.Key.empty
|
||||
|> map_err_to_string Keys_ro.pp_error
|
||||
in
|
||||
let keys = List.filter (fun (_, t) -> t = `Value) keys in
|
||||
Certificates_ro.list certificate_ro Mirage_kv.Key.empty
|
||||
|> map_err_to_string Certificates_ro.pp_error
|
||||
>>= fun certificates ->
|
||||
let*? certificates =
|
||||
Certificates_ro.list certificate_ro Mirage_kv.Key.empty
|
||||
|> map_err_to_string Certificates_ro.pp_error
|
||||
in
|
||||
let certificates = List.filter (fun (_, t) -> t = `Value) certificates in
|
||||
let fold acc (name, _) =
|
||||
match Mirage_kv.Key.basename name with
|
||||
| ".gitkeep" -> Lwt.return acc
|
||||
| _ ->
|
||||
Certificates_ro.get certificate_ro name
|
||||
|> map_err_to_string Certificates_ro.pp_error
|
||||
>>= (Lwt.return <.> X509.Certificate.decode_pem_multiple)
|
||||
>>= fun certificates ->
|
||||
Lwt.return acc >>= fun acc ->
|
||||
Lwt.return_ok ((name, certificates) :: acc)
|
||||
let*? data =
|
||||
Certificates_ro.get certificate_ro name
|
||||
|> map_err_to_string Certificates_ro.pp_error
|
||||
in
|
||||
let*? certificates =
|
||||
Lwt.return (X509.Certificate.decode_pem_multiple data)
|
||||
in
|
||||
let+? acc = Lwt.return acc in
|
||||
(name, certificates) :: acc
|
||||
in
|
||||
Lwt_list.fold_left_s fold (Ok []) certificates >>= fun certificates ->
|
||||
let*? certificates = Lwt_list.fold_left_s fold (Ok []) certificates in
|
||||
let fold acc (name, _) =
|
||||
match Mirage_kv.Key.basename name with
|
||||
| ".gitkeep" -> Lwt.return acc
|
||||
| _ ->
|
||||
Keys_ro.get key_ro name
|
||||
|> map_err_to_string Keys_ro.pp_error
|
||||
>>= (Lwt.return <.> X509.Private_key.decode_pem)
|
||||
>>= fun key ->
|
||||
Lwt.return acc >>= fun acc -> Lwt.return_ok ((name, key) :: acc)
|
||||
let*? data =
|
||||
Keys_ro.get key_ro name |> map_err_to_string Keys_ro.pp_error
|
||||
in
|
||||
let*? key = Lwt.return (X509.Private_key.decode_pem data) in
|
||||
let+? acc = Lwt.return acc in
|
||||
(name, key) :: acc
|
||||
in
|
||||
Lwt_list.fold_left_s fold (Ok []) keys >>= fun keys ->
|
||||
let+? keys = Lwt_list.fold_left_s fold (Ok []) keys in
|
||||
let tbl = Hashtbl.create 0x10 in
|
||||
List.iter
|
||||
(fun (name, certificates) ->
|
||||
|
|
@ -188,9 +195,9 @@ struct
|
|||
| None -> ())
|
||||
certificates;
|
||||
match Hashtbl.fold (fun _ certchain acc -> certchain :: acc) tbl [] with
|
||||
| [] -> Lwt.return_ok `None
|
||||
| [ certchain ] -> Lwt.return_ok (`Single certchain)
|
||||
| certchains -> Lwt.return_ok (`Multiple certchains)
|
||||
| [] -> `None
|
||||
| [ certchain ] -> `Single certchain
|
||||
| certchains -> `Multiple certchains
|
||||
|
||||
let http_1_1_request_handler ~ctx ~authenticator flow _edn =
|
||||
let module R = (val Mimic.repr HTTP_server.tcp_protocol) in
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue