open Mirage type http_client = HTTP_client let http_client = typ HTTP_client let check = let doc = Key.Arg.info ~doc:"Only check the cache" ["check"] in Key.(create "check" Arg.(flag doc)) let verify = let doc = Key.Arg.info ~doc:"Verify the cache contents" ["verify"] in Key.(create "verify" Arg.(flag doc)) let remote = let doc = Key.Arg.info ~doc:"Remote repository url" ["remote"] in Key.(create "remote" Arg.(opt string "https://opam.ocaml.org" doc)) let parallel_downloads = let doc = Key.Arg.info ~doc:"Amount of parallel HTTP downloads" ["parallel-downloads"] in Key.(create "parallel-downloads" Arg.(opt int 20 doc)) let hook_url = let doc = Key.Arg.info ~doc:"URL to conduct an update of the opam repository" ["hook-url"] in Key.(create "hook-url" Arg.(opt string "update" doc)) let port = let doc = Key.Arg.info ~doc:"HTTP listen port." ["port"] in Key.(create "port" Arg.(opt int 80 doc)) let tls_authenticator = (* this will not look the same in the help printout *) let doc = "TLS host authenticator. See git_http in lib/mirage/mirage.mli for a description of the format." in let doc = Key.Arg.info ~doc ["tls-authenticator"] in Key.(create "tls-authenticator" Arg.(opt (some string) None doc)) let sectors_cache = let doc = "Number of sectors reserved for each checksum cache (md5, sha512)." in let doc = Key.Arg.info ~doc ["sectors-cache"] in Key.(create "sectors-cache" Arg.(opt int64 Int64.(mul 4L 2048L) doc)) let mirror = foreign "Unikernel.Make" ~keys:[ Key.v check ; Key.v verify ; Key.v remote ; Key.v parallel_downloads ; Key.v hook_url ; Key.v tls_authenticator ; Key.v port ; Key.v sectors_cache ; ] ~packages:[ package ~min:"0.2.0" ~sublibs:[ "mirage" ] "paf" ; package "h2" ; package "httpaf" ; package "opam-file-format" ; package ~min:"2.1.0" ~sublibs:[ "gz" ] "tar" ~pin:"git+https://github.com/hannesm/ocaml-tar.git#kv-rw-kv-5" ; package ~pin:"git+https://github.com/hannesm/ocaml-tar.git#kv-rw-kv-5" "tar-mirage" ; package "mirage-block-partition" ; package "oneffs" ; package "hex" ; ] (block @-> time @-> pclock @-> stackv4v6 @-> http_client @-> job) let stack = generic_stackv4v6 default_network let dns = generic_dns_client stack let tcp = tcpv4v6_of_stackv4v6 stack let http_client = let connect _ modname = function | [ _time; _pclock; _tcpv4v6; ctx ] -> Fmt.str {ocaml|%s.connect %s|ocaml} modname ctx | _ -> assert false in impl ~connect "Http_mirage_client.Make" (time @-> pclock @-> tcpv4v6 @-> git_client @-> http_client) (* XXX(dinosaure): [git_client] seems bad but it becames from a long discussion when a "mimic" device seems not accepted by everyone. We can copy [git_happy_eyeballs] and provide an [http_client] instead of a [git_client] but that mostly means that 2 instances of happy-eyeballs will exists together which is not really good (it puts a pressure on the scheduler). *) let http_client = let happy_eyeballs = generic_happy_eyeballs stack dns in let happy_eyeballs = git_happy_eyeballs stack dns happy_eyeballs in http_client $ default_time $ default_posix_clock $ tcp $ happy_eyeballs let program_block_size = let doc = Key.Arg.info [ "program-block-size" ] in Key.(create "program_block_size" Arg.(opt int 16 doc)) let block = block_of_file "tar" let () = register "mirror" [ mirror $ block $ default_time $ default_posix_clock $ stack $ http_client ]