Merge pull request #1981 from talex5/https-unikernel

Add https example

projects/miragesdk/examples/https-unikernel/.dockerignore

@@ -0,0 +1,5 @@
+_build
+rpc
+Dockerfile
+tls-secrets
+www-data

projects/miragesdk/examples/https-unikernel/.gitignore

@@ -0,0 +1,8 @@
+.merlin
+_build
+proto.ml
+proto.mli
+lib/schema.ml
+lib/schema.mli
+www-data
+tls-secrets

projects/miragesdk/examples/https-unikernel/Dockerfile

@@ -0,0 +1,23 @@
+FROM ocaml/opam@sha256:a469435632d0cacbceab799d7e48201b727d025fa1805cbbe210d94233b251ad
+#FROM ocaml/opam:debian-9_ocaml-4.04.0
+RUN opam pin add -yn capnp 'https://github.com/talex5/capnp-ocaml.git#demo1'
+RUN opam pin add -yn capnp-rpc 'https://github.com/talex5/capnp-rpc.git#demo1'
+RUN opam pin add -yn capnp-rpc-lwt 'https://github.com/talex5/capnp-rpc.git#demo1'
+RUN opam depext -i -y jbuilder lwt cohttp astring tls capnp camlzip alcotest cohttp
+RUN sudo apt-get install -y screen python-pip python-setuptools python-dev --no-install-recommends
+RUN pip install cython pycapnp
+ADD opam /home/opam/src/opam
+RUN opam pin add -ny mypkg /home/opam/src
+RUN opam install --deps-only mypkg
+ENV JBUILD_STATIC=true
+WORKDIR /home/opam/src
+ADD . /home/opam/src
+RUN sudo chown -R opam .
+RUN opam config exec -- make
+USER root
+RUN cp _build/default/src/main.exe /usr/bin/https-unikernel-single && \
+    cp _build/default/src/store_main.exe /usr/bin/https-unikernel-store && \
+    cp _build/default/src/http_main.exe /usr/bin/https-unikernel-http && \
+    cp _build/default/src/tls_main.exe /usr/bin/https-unikernel-tls
+USER opam
+ENV SHELL=bash

projects/miragesdk/examples/https-unikernel/Makefile

@@ -0,0 +1,31 @@
+.PHONY: all docker docker-run clean
+
+all: www-data
+	jbuilder build --dev src/main.exe src/store_main.exe src/http_main.exe src/tls_main.exe
+
+docker:
+	docker build -t https-unikernel .
+
+docker-run: tls-secrets/server.crt
+	docker run --rm -it -v ${PWD}/tls-secrets:/home/opam/src/tls-secrets -p 8443:8443 https-unikernel bash -c 'reset; screen'
+
+clean:
+	rm -rf _build
+
+tls-secrets/server.key:
+	@echo Generating server key...
+	[ -d tls-secrets ] || mkdir -p tls-secrets
+	openssl genrsa -out $@ 4096
+
+tls-secrets/server.crt: tls-secrets/server.key
+	@echo ">>> Generating server X.509 certificate."
+	@echo ">>> Enter the server's full hostname as the 'Common Name' (e.g. demo.mynet)."
+	@echo ">>> Everything else can be left blank."
+	@echo
+	@openssl req -new -x509 -key $< -out $@ -days 10000
+
+www-data:
+	git init www-data
+	echo '<p>It works!</p><p>Powered by Irmin.</p>' > www-data/index.html
+	git -C www-data add index.html
+	git -C www-data commit --author 'Test <test@example.com>' -m 'Initial state'

projects/miragesdk/examples/https-unikernel/README.md

@@ -0,0 +1,70 @@
+## https-unikernel example service
+
+This sample service implements an https web-server as a set of three components communicating using [Cap'n Proto RPC][].
+
+1. The `store` service accepts requests for web pages and returns the page content.
+2. The `http` service accepts HTTP connections over RPC and handles GET requests using `store`.
+3. The `tls` service accepts encrypted HTTPS connections and provides them as a plain-text stream to `http`.
+
+The protocols implemented by the services can be found in the `proto.capnp` file.
+
+The services can be run in separate processes so that they are isolated from each other.
+For example, only the `tls` component needs access to the private key, so
+a bug in the HTTP protocol decoder cannot leak the key.
+
+Although the example services are all written in OCaml, it should be possible to replace any of them with a different implementation written in any other language with Cap'n Proto RPC support.
+
+### Running the samples
+
+The easiest way to build and run is using Docker:
+
+    make docker
+    make docker-run
+
+Once inside the container, you can run all the services in a single process like this:
+
+    reset
+    https-unikernel-single
+
+You should be able to try out the service by opening <https://localhost:8443> in a browser.
+
+You can also run the service as three separate processes.
+The easiest way to do this is by running `screen`.
+
+First, start the store:
+
+    https-unikernel-store /tmp/store.sock
+
+Then, create a new window (`Ctrl-A c`) and start the http service:
+
+    https-unikernel-http /tmp/http.sock --store=/tmp/store.sock
+
+Finally, make another window and run the TLS terminator:
+
+    https-unikernel-tls --http /tmp/http.sock --port 8443
+
+
+### Testing with Python
+
+With the services running as separate processes (i.e. with socket files available), you can also invoke services from other languages.
+For example, using Python (make another screen split):
+
+```
+$ cd src
+$ python
+>>> import capnp
+>>> import proto_capnp
+>>> import socket
+>>> s = socket.socket(socket.AF_UNIX, socket.SOCK_STREAM, 0)
+>>> s.connect('/tmp/store.sock')
+>>> client = capnp.TwoPartyClient(s)
+>>> store = client.bootstrap().cast_as(proto_capnp.Store)
+>>> r = store.get(['index.html'])
+>>> print r.wait()
+( ok = "<p>It works!</p><p>Powered by Irmin.</p>\n" )
+```
+
+(or just do `python test_store.py`)
+
+
+[Cap'n Proto RPC]: https://capnproto.org/rpc.html

projects/miragesdk/examples/https-unikernel/opam

@@ -0,0 +1,18 @@
+opam-version: "1.2"
+name: "https-unikernel"
+version: "0.1"
+maintainer: "Thomas Leonard <thomas.leonard@docker.com>"
+authors: "Thomas Leonard <thomas.leonard@docker.com>"
+build: [
+  [make]
+]
+depends: [
+  "lwt"
+  "cohttp"
+  "astring"
+  "tls"
+  "irmin-unix"
+  "capnp-rpc-lwt"
+  "jbuilder" {build}
+  "ocamlfind" {build}
+]

projects/miragesdk/examples/https-unikernel/src/api.ml

@@ -0,0 +1 @@
+include Proto.MakeRPC(Capnp.BytesMessage)(Capnp_rpc_lwt)

projects/miragesdk/examples/https-unikernel/src/common.ml

@@ -0,0 +1,77 @@
+open Lwt.Infix
+open Capnp_rpc_lwt
+
+let connect ~switch path =
+  Logs.info (fun f -> f "Connecting to %S" path);
+  let socket = Unix.(socket PF_UNIX SOCK_STREAM 0) in
+  begin
+    try Unix.connect socket (Unix.ADDR_UNIX path)
+    with Unix.Unix_error(Unix.ECONNREFUSED, "connect", "") ->
+    Logs.err (fun f -> f "Failed to connect to %S" path);
+    exit 1
+  end;
+  let endpoint = Endpoint.of_socket ~switch socket in
+  let conn = CapTP.of_endpoint ~switch endpoint in
+  CapTP.bootstrap conn
+
+let rm_socket path =
+  match Unix.lstat path with
+  | stat when stat.Unix.st_kind = Unix.S_SOCK -> Unix.unlink path
+  | _ -> failwith (Fmt.strf "%S exists and is not a socket" path)
+  | exception Unix.Unix_error(Unix.ENOENT, "lstat", _) -> ()
+
+let listen ~switch ~offer path =
+  let socket = Unix.(socket PF_UNIX SOCK_STREAM 0) in
+  Lwt_switch.add_hook (Some switch) (fun () -> Unix.close socket; Lwt.return_unit);
+  rm_socket path;
+  Unix.bind socket (Unix.ADDR_UNIX path);
+  Unix.listen socket 5;
+  let socket = Lwt_unix.of_unix_file_descr socket in
+  Logs.info (fun f -> f "Waiting for connections on %S" path);
+  let rec loop () =
+    Lwt_unix.accept socket >>= fun (c, _) ->
+    Logs.info (fun f -> f "Got connection on %S" path);
+    Lwt_switch.with_switch @@ fun switch ->     (* todo: with_child_switch *)
+    let endpoint = Endpoint.of_socket ~switch (Lwt_unix.unix_file_descr c) in
+    ignore (CapTP.of_endpoint ~switch ~offer endpoint);
+    loop () in
+  loop ()
+
+module Actor = struct
+  type t = Fmt.style * string
+  let pp f (style, name) = Fmt.(styled style (const string name)) f ()
+  let tag = Logs.Tag.def "actor" pp
+end
+
+let pp_qid f = function
+  | None -> ()
+  | Some x ->
+    let s = Uint32.to_string x in
+    Fmt.(styled `Magenta (fun f x -> Fmt.pf f " (qid=%s)" x)) f s
+
+let reporter =
+  let report src level ~over k msgf =
+    let src = Logs.Src.name src in
+    msgf @@ fun ?header ?(tags=Logs.Tag.empty) fmt ->
+    let actor =
+      match Logs.Tag.find Actor.tag tags with
+      | Some x -> x
+      | None -> `Black, "------"
+    in
+    let qid = Logs.Tag.find Capnp_rpc.Debug.qid_tag tags in
+    let print _ =
+      Fmt.(pf stderr) "%a@." pp_qid qid;
+      over ();
+      k ()
+    in
+    Fmt.kpf print Fmt.stderr ("%a %a %a: @[" ^^ fmt ^^ "@]")
+      Fmt.(styled `Magenta string) (Printf.sprintf "%11s" src)
+      Logs_fmt.pp_header (level, header)
+      Actor.pp actor
+  in
+  { Logs.report = report }
+
+let init_logging () =
+  Fmt_tty.setup_std_outputs ();
+  Logs.set_reporter reporter;
+  Logs.set_level (Some Logs.Info)

projects/miragesdk/examples/https-unikernel/src/debug.ml

@@ -0,0 +1 @@
+let endpoint_tag = Logs.Tag.def "endpoint" Fmt.string

projects/miragesdk/examples/https-unikernel/src/http_main.ml

@@ -0,0 +1,24 @@
+let () = Common.init_logging ()
+
+let main store_socket http_socket =
+  Lwt_main.run begin
+    Lwt_switch.with_switch @@ fun switch ->
+    let store = Common.connect ~switch store_socket in
+    let http = Http_server.service store in
+    Common.listen ~switch ~offer:http http_socket
+  end
+
+open Cmdliner
+
+let store =
+  let doc = "The database store to use" in
+  Arg.(required @@ opt (some string) None @@ info ~doc ~docv:"STORE" ["store"])
+
+let http =
+  let doc = "The http socket to provide" in
+  Arg.(required @@ pos 0 (some string) None @@ info ~doc ~docv:"HTTP" [])
+
+let cmd =
+  Term.(const main $ store $ http), Term.info "http"
+
+let () = Term.(exit @@ eval cmd)

projects/miragesdk/examples/https-unikernel/src/http_server.ml

@@ -0,0 +1,135 @@
+let src = Logs.Src.create "web.http" ~doc:"HTTP engine for web server"
+module Log = (val Logs.src_log src: Logs.LOG)
+
+open Capnp_rpc_lwt
+open Lwt.Infix
+open Astring
+
+module Remote_flow = struct
+  type buffer = Cstruct.t
+  type flow = Api.Reader.Flow.t Capability.t
+  type error = [`Capnp of Capnp_rpc.Error.t]
+  type write_error = [Mirage_flow.write_error | `Capnp of Capnp_rpc.Error.t]
+  type 'a io = 'a Lwt.t
+
+  let create x = x
+
+  let read t =
+    let module R = Api.Reader.Flow.Read_results in
+    let req = Capability.Request.create_no_args () in
+    let proxy = new Api.Reader.Flow.client t in
+    Capability.call_for_value_exn proxy#read req >>= fun resp ->
+    let p = R.of_payload resp in
+    let data = R.data_get p in
+    Lwt.return (Ok (`Data (Cstruct.of_string data)))
+
+  let write t data =
+    let module P = Api.Builder.Flow.Write_params in
+    let req, p = Capability.Request.create P.init_pointer in
+    let proxy = new Api.Reader.Flow.client t in
+    P.data_set p (Cstruct.to_string data);
+    Capability.call_for_value_exn proxy#write req >>= fun _ ->
+    Lwt.return (Ok ())
+
+  let writev t data =
+    write t (Cstruct.concat data)
+
+  let close _ = failwith "TODO: close"
+
+  let pp_error f = function
+    | `Capnp e -> Capnp_rpc.Error.pp f e
+    | `Closed -> Fmt.string f "Closed"
+
+  let pp_write_error f = function
+    | `Capnp e -> Capnp_rpc.Error.pp f e
+    | #Mirage_flow.write_error as e -> Mirage_flow.pp_write_error f e
+end
+
+module IO = struct
+  type 'a t = 'a Lwt.t
+  let (>>=) = Lwt.bind
+  let return = Lwt.return
+
+  type ic = Lwt_io.input_channel
+  type oc = Lwt_io.output_channel
+  type conn = Remote_flow.flow
+
+  let read_line ic =
+    Lwt_io.read_line_opt ic
+
+  let read ic count =
+    let count = min count Sys.max_string_length in
+    Lwt_io.read ~count ic
+
+  let write oc buf =
+    Lwt_io.write oc buf
+
+  let flush oc =
+    Lwt_io.flush oc
+end
+
+module Server = Cohttp_lwt.Make_server(IO)
+
+type t = Api.Reader.Store.t Capability.t
+
+(* Make a Cap'n'Proto call to the store service *)
+let get t path =
+  let module P = Api.Builder.Store.Get_params in
+  let req, p = Capability.Request.create P.init_pointer in
+  ignore (P.path_set_list p path);
+  let proxy = new Api.Reader.Store.client t in
+  Capability.call_for_value_exn proxy#get req >>= fun resp ->
+  let open Api.Reader.Store in
+  match GetResults.get (GetResults.of_payload resp) with
+  | GetResults.NotFound -> Lwt.return None
+  | GetResults.Ok data -> Lwt.return (Some data)
+  | GetResults.Undefined _ -> failwith "Protocol error: bad msg type"
+
+(* Handle HTTP requests *)
+let callback t _conn req _body =
+  let open Cohttp in
+  let uri = Request.uri req in
+  Log.info (fun f -> f "HTTP request for %a" Uri.pp_hum uri);
+  match Request.meth req with
+  | `GET ->
+    let path = String.cuts ~empty:false ~sep:"/" (Uri.path uri) in
+    let path =
+      match path with
+      | [] -> ["index.html"]
+      | p -> p
+    in
+    begin get t path >>= function
+    | Some body -> Server.respond_string ~status:`OK ~body ()
+    | None -> Server.respond_not_found ~uri ()
+    end
+  | m ->
+    let body = Fmt.strf "Bad method %S" (Code.string_of_method m) in
+    Server.respond_error ~status:`Bad_request ~body ()
+
+let callback t = Server.callback (Server.make ~callback:(callback t) ())
+
+module Remote_flow_unix = Mirage_flow_unix.Make(Remote_flow)
+
+let handle_connection store c =
+  Log.info (fun f -> f "Handing new connection");
+  let flow = Remote_flow.create c in
+  callback store flow (Remote_flow_unix.ic flow) (Remote_flow_unix.oc flow) >>= fun () ->
+  Capability.dec_ref c;
+  Lwt.return_unit
+
+let service store =
+  Api.Builder.HttpServer.local @@
+    object (_ : Api.Builder.HttpServer.service)
+      method accept req =
+        Log.info (fun f -> f "Handing new connection");
+        let module P = Api.Reader.HttpServer.Accept_params in
+        let p = P.of_payload req in
+        match P.connection_get p with
+        | None -> Service.fail "No connection!"
+        | Some i ->
+          let c = Payload.import req i in
+          Service.return_lwt (fun () ->
+            handle_connection store c >|= fun () ->
+            Ok (Service.Response.create_empty ())
+          )
+    end

projects/miragesdk/examples/https-unikernel/src/jbuild

@@ -0,0 +1,25 @@
+(* -*- tuareg -*- *)
+open Jbuild_plugin.V1
+
+let extra_flags =
+  match Sys.getenv "JBUILD_STATIC" with
+  | "true" -> "-cclib -static"
+  | x -> failwith (Printf.sprintf "JBUILD_STATIC: unknown value %S" x)
+  | exception Not_found -> ""
+
+let sexp = Printf.sprintf {|
+  (jbuild_version 1)
+
+  (executables (
+    (names (main store_main http_main tls_main))
+    (libraries (capnp-rpc-lwt cohttp.lwt irmin-unix cmdliner fmt.tty))
+    (flags (:standard -w -53-55 %s))
+  ))
+  (rule
+   ((targets (proto.ml proto.mli))
+    (deps (proto.capnp))
+    (action  (run capnpc -o ocaml ${<}))))
+|} extra_flags
+
+let () =
+  send sexp

projects/miragesdk/examples/https-unikernel/src/main.ml

@@ -0,0 +1,37 @@
+open Lwt.Infix
+open Capnp_rpc_lwt
+
+let switch = Lwt_switch.create ()
+
+let socket_pair ~switch =
+  let client, server = Unix.(socketpair PF_UNIX SOCK_STREAM 0) in
+  Lwt_switch.add_hook (Some switch) (fun () ->
+      Unix.close client;
+      Unix.close server;
+      Lwt.return ()
+    );
+  (Endpoint.of_socket ~switch client, Endpoint.of_socket ~switch server)
+
+let store_to_http, http_to_store = socket_pair ~switch
+let http_to_tls, tls_to_http = socket_pair ~switch
+
+let () =
+  Common.init_logging ();
+  Lwt_main.run begin
+    begin
+      Store.service () >>= fun service ->
+      let tags = Logs.Tag.add Common.Actor.tag (`Green, "Store ") Logs.Tag.empty in
+      let _ : CapTP.t = CapTP.of_endpoint ~offer:service ~tags ~switch store_to_http in
+      Lwt.return ()
+    end
+    >>= fun () ->
+    begin
+      let tags = Logs.Tag.add Common.Actor.tag (`Red, "HTTP  ") Logs.Tag.empty in
+      let store = CapTP.bootstrap (CapTP.of_endpoint ~tags ~switch http_to_store) in
+      let service = Http_server.service store in
+      let _ : CapTP.t = CapTP.of_endpoint ~offer:service ~tags ~switch http_to_tls in
+      Lwt.return ()
+    end
+    >>= fun () ->
+    Tls_terminator.init ~switch ~to_http:tls_to_http
+  end

projects/miragesdk/examples/https-unikernel/src/proto.capnp

@@ -0,0 +1,21 @@
+@0xe81d238ec50a0daa;
+
+interface Store {
+  struct GetResults {
+    union {
+      ok @0 :Text;
+      notFound @1 :Void;
+    }
+  }
+
+  get @0 (path :List(Text)) -> GetResults;
+}
+
+interface Flow {
+  read @0 () -> (data :Data);
+  write @1 (data :Data) -> ();
+}
+
+interface HttpServer {
+  accept @0 (connection :Flow) -> ();
+}

projects/miragesdk/examples/https-unikernel/src/store.ml

@@ -0,0 +1,33 @@
+let src = Logs.Src.create "web.store" ~doc:"Datastore for web server"
+module Log = (val Logs.src_log src: Logs.LOG)
+
+module Irmin_store = Irmin_unix.Git.FS.KV(Irmin.Contents.String)
+
+open Lwt.Infix
+open Capnp_rpc_lwt
+open Astring
+
+(* The Cap'n'Proto service interface we expose. *)
+let service () =
+  let config = Irmin_fs.config "www-data" in 
+  Irmin_store.Repo.v config >>= fun repo ->
+  Irmin_store.of_branch repo Irmin_store.Branch.master >|= fun db ->
+  Api.Builder.Store.local @@
+    object (_ : Api.Builder.Store.service)
+      method get req =
+        let module P = Api.Reader.Store.Get_params in
+        let module R = Api.Builder.Store.GetResults in
+        let params = P.of_payload req in
+        let path = P.path_get_list params in
+        Log.info (fun f -> f "Handing request for %a" (Fmt.Dump.list String.dump) path);
+        Service.return_lwt (fun () ->
+          let resp, results = Service.Response.create R.init_pointer in
+          begin
+            Irmin_store.find db path >|= function
+            | Some data -> R.ok_set results data
+            | None -> R.not_found_set results
+          end
+          >>= fun () ->
+          Lwt.return (Ok resp)
+        )
+    end

projects/miragesdk/examples/https-unikernel/src/store_main.ml

@@ -0,0 +1,21 @@
+open Lwt.Infix
+
+let () = Common.init_logging ()
+
+let main store_socket =
+  Lwt_main.run begin
+    Lwt_switch.with_switch @@ fun switch ->
+    Store.service () >>= fun store ->
+    Common.listen ~switch ~offer:store store_socket
+  end
+
+open Cmdliner
+
+let store =
+  let doc = "The database store to serve" in
+  Arg.(required @@ pos 0 (some string) None @@ info ~doc ~docv:"STORE" [])
+
+let cmd =
+  Term.(const main $ store), Term.info "store" 
+
+let () = Term.(exit @@ eval cmd)

projects/miragesdk/examples/https-unikernel/src/test_store.py

@@ -0,0 +1,10 @@
+import capnp
+import capnp
+import proto_capnp
+import socket
+s = socket.socket(socket.AF_UNIX, socket.SOCK_STREAM, 0)
+s.connect('/tmp/store.sock')
+client = capnp.TwoPartyClient(s)
+store = client.bootstrap().cast_as(proto_capnp.Store)
+r = store.get(['index.html'])
+print r.wait()

projects/miragesdk/examples/https-unikernel/src/tls_main.ml

@@ -0,0 +1,23 @@
+let () = Common.init_logging ()
+
+let main http_socket port =
+  Lwt_main.run begin
+    Lwt_switch.with_switch @@ fun switch ->
+    let http_service = Common.connect ~switch http_socket in
+    Tls_terminator.run ~http_service ~port
+  end
+
+open Cmdliner
+
+let http =
+  let doc = "The HTTP service to use" in
+  Arg.(required @@ opt (some string) None @@ info ~doc ~docv:"HTTP" ["http"])
+
+let tls =
+  let doc = "The TLS port on which to listen for incoming connections" in
+  Arg.(value @@ opt int 8443 @@ info ~doc ~docv:"PORT" ["port"])
+
+let cmd =
+  Term.(const main $ http $ tls), Term.info "tls"
+
+let () = Term.(exit @@ eval cmd)

projects/miragesdk/examples/https-unikernel/src/tls_terminator.ml

@@ -0,0 +1,53 @@
+open Lwt.Infix
+open Capnp_rpc_lwt
+
+let make_flow _flow ic oc =
+  Api.Builder.Flow.local @@
+    object (_ : Api.Builder.Flow.service)
+      method read _ =
+        Service.return_lwt (fun () ->
+          Lwt_io.read ~count:4096 ic >|= fun data ->
+          let module R = Api.Builder.Flow.Read_results in
+          let resp, results = Service.Response.create R.init_pointer in
+          R.data_set results data;
+          Ok resp
+        )
+
+      method write req =
+        let module R = Api.Reader.Flow.Write_params in
+        let p = R.of_payload req in
+        let data = R.data_get p in
+        Service.return_lwt (fun () ->
+          Lwt_io.write oc data >>= fun () ->
+          Lwt.return (Ok (Service.Response.create_empty ()))
+        )
+    end
+
+let handle ~http_service flow =
+  let proxy = new Api.Reader.HttpServer.client http_service in
+  let module P = Api.Builder.HttpServer.Accept_params in
+  let req, p = Capability.Request.create P.init_pointer in
+  P.connection_set p (Some (Capability.Request.export req flow));
+  Capability.call_for_value proxy#accept req >|= function
+  | Ok _ -> ()
+  | Error e -> Logs.warn (fun f -> f "Error from HTTP server: %a" Capnp_rpc.Error.pp e)
+
+let run ~port ~http_service =
+  let tls_config : Conduit_lwt_unix.server_tls_config =
+    `Crt_file_path "tls-secrets/server.crt",
+    `Key_file_path "tls-secrets/server.key",
+    `No_password,
+    `Port port
+  in
+  let mode = `TLS tls_config in
+  Logs.info (fun f -> f "Listening on https port %d" port);
+  Conduit_lwt_unix.(serve ~ctx:default_ctx) ~mode (fun flow ic oc ->
+      Logs.info (fun f -> f "Got new TLS connection");
+      let flow_obj = make_flow flow ic oc in
+      handle ~http_service flow_obj
+    )
+
+let init ~switch ~to_http =
+  let tags = Logs.Tag.add Common.Actor.tag (`Blue, "TLS   ") Logs.Tag.empty in
+  let http_service = CapTP.bootstrap (CapTP.of_endpoint ~tags ~switch to_http) in
+  run ~http_service ~port:8443