Skip to content

Instantly share code, notes, and snippets.

@zbroyar
Created June 3, 2024 22:58
Show Gist options
  • Save zbroyar/cfc6b28a36a88adc0b4ac477212e24ee to your computer and use it in GitHub Desktop.
Save zbroyar/cfc6b28a36a88adc0b4ac477212e24ee to your computer and use it in GitHub Desktop.
Auth your cohttp request with x509 certificate
(* ocamlfind ocamlopt -thread -package lwt,tls,x509,cohttp,cohttp-lwt,lwt_ppx,cohttp-lwt-unix -linkpkg cohttp_tls.ml *)
open Lwt
open Printf
open Cohttp
open Cohttp_lwt_unix
let ca_file = "ca-chain.crt"
let cert_file = "your.crt"
let key_file = "your_private.key"
let get_url = "https://your.server/path/to/resource"
let tls_own_key = `TLS (
(`Crt_file_path cert_file),
(`Key_file_path key_file),
(`No_password )
)
let request () =
let%lwt anchors =
Lwt_io.(with_file ~mode:Input ca_file read) >>= fun str ->
match
X509.Certificate.decode_pem_multiple @@ Cstruct.of_string str
with Ok r -> return r | Error (`Msg s) ->
failwith @@ sprintf "can't decode PEM: %s" s
in
let tls_authenticator ?ip ~host certs =
ignore ip;
ignore host;
X509.Validation.verify_chain_of_trust
~host:None
~time:(fun () -> None)
~allowed_hashes:[ `SHA256 ; `SHA384 ; `SHA512 ]
~anchors certs
in
let%lwt ctx = Conduit_lwt_unix.init ~tls_own_key ~tls_authenticator () in
let ctx = { Net.default_ctx with ctx } in
let%lwt (resp,body) =
Lwt_unix.with_timeout 20.0 @@
(fun () -> Client.get ~ctx (Uri.of_string get_url))
in
let rc = resp |> Response.status |> Code.code_of_status in
let%lwt body = Cohttp_lwt.Body.to_string body in
printf "I: request is sent, answer: %d\n%s\n%!" rc body;
return_unit
let _ = Lwt_main.run @@ request ()
@zbroyar
Copy link
Author

zbroyar commented Jun 3, 2024

Important detail: for this code to work you must have tls-lwt and ca-certs opam packages installed due to optional compilation of ocaml-conduit.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment