(*
 * Copyright (c) 2013 Thomas Gazagnaire <thomas@gazagnaire.org>
 * Copyright (c) 2013 Anil Madhavapeddy <anil@recoil.org>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

(** {e Release v4.10.3} *)

(** {1 What is MirageOS?}

    MirageOS is a library operating system that can build standalone unikernels
    on various platforms. More precisely, the architecture can be divided into:

    - {e operating system libraries} that implement kernel and protocol
      functionality, ranging from low-level network card drivers to a full
      reimplementation of the TLS protocol, through to a reimplementation of the
      Git protocol to store versioned data.

    - A set of {e typed signatures} to make sure these libraries are consistent
      and can interoperate. As all the library are almost all pure OCaml code,
      we have defined {e a set of OCaml module types} that encode these
      conventions in a statically enforcable way. We make no compatibility
      guarantees at the C level, but compile those on a best-effort basis.

    - Finally, MirageOS is also a {e metaprogramming compiler} that generates
      OCaml code. It takes as input: the OCaml source code of a program and all
      of its dependencies, the full description of the deployment target,
      including configuration values (like the HTTP port to listen on, or the
      private key or the service being deployed). The `mirage`CLI tool uses all
      of these to {e generate a executable unikernel}: a specialised binary
      artefact containing only the code what is needed to run on the given
      deployment platform and no more.

    It is possible to write high-level MirageOS applications, such as HTTPS,
    email or CalDAV servers which can be deployed on very heterogenous and
    embedded platforms by changing only a few compilation parameters. The
    supported platforms range from minimal virtual machines running on cloud
    providers, or processes running inside Docker containers configured with a
    tight security profile. In general, these platform do not have a full POSIX
    environment; MirageOS does not try to emulate POSIX and focuses on providing
    a small, well-defined, typed interface with the system components. The
    nearest equivalent to the MirageOS approach is the WASI (wasi.dev) set of
    interfaces for WebAssembly.

    {2 Is everything really written in OCaml?}

    While most of the code is written in OCaml, a typed, high-level language
    with many good safety properties, there are pieces of MirageOS which are
    still written in C. These bits can be separated in three categories:

    - The OCaml runtime is written in C. It needs to be ported to the platform
      that MirageOS is trying to target, which do not support POSIX. Hence, the
      first component to port to a new platform is the OCaml runtime.

    - The low-level device drivers (network, console, clock, etc) also need some
      C bits.

    - The base usual C bindings; some libraries are widely used and
      (unfortunately) very hard (but not impossible) to replace them completely
      without taking a big performance hit or having to trust code without much
      real-world usages. This is the case for low-level bit handling for crypto
      code (even if we try to make sure allocation is alway handled by the OCaml
      runtime) as well as arbitrary precision numeric computation (e.g. gmp).
      Ideally we could image rewriting all of these libraries in OCaml if we had
      an infinite amount of time in our hands.

    {2 MirageOS as a cross-compilator}

    The MirageOS compiler is basically a cross-compiler, where the host and
    target toolchain are identical, but with different flags for the C bindings:
    for instance, it is necessary to pass [-freestanding] to {e all} C bindings
    to not use POSIX headers. The MirageOS compiler also uses a custom linker:
    eg. not only it needs a custom OCaml's runtime [libasmrun.a], but it also
    needs to run a different linker to generate specialised executable images.

    Historically, the OCaml ecosystem always had partial support for
    cross-compilation: for instance, the
    {{:https://github.com/ocaml-cross/opam-cross-windows} ocaml-cross} way of
    doing it is to duplicate {e all} existing opam pacakges by adding a
    [-windows] suffix to their names and dependencies; this allows normal
    packages and windows packages can be co-installed in the same opam switch.

    {3 MirageOS 3.x}

    MirageOS 3.x solves this by duplicating only the packages defining C
    bindings. It relies on every MirageOS backend registering a set of [CFLAGS]
    with [pkg-config]. Then every bindings uses [pkg-config] to configure their
    [CFLAGS] and [ocamlfind] to register
    {{:https://github.com/ocaml/opam-repository/blob/master/packages/zarith-xen/zarith-xen.1.7/files/mirage-install.sh#L20}
     link-time predicates}, e.g. additional link time options like the name of
    the C archives. Finally, the final link step is done by querying ocamlfind
    (using the custom registered predicates) to link the list of dependencies'
    objects files with the result of OCam compiler's [--output-obj] option.

    {4 MirageOS 4.x}

    MirageOS 4 solves this by relying on [dune]'s built-in support for
    cross-compilation. This is done by gathering all the sources of the
    dependencies locally with [opam-monorepo], and by creating a
    `dune-workspace` file describing the C flags to use in each
    cross-compilation "context". Once this is set-up, only one [dune build] can
    cross-compile the unikernel target with all its local sources.

    {1 MirageOS eDSL}

    The rest of the document describes Functoria, the embedded domain-specific
    language to be used in [config.ml] files, to described how the typed
    libraries have to be assembled. *)

include Functoria.DSL
(** @inline *)

(** Configuration keys. *)
module Key : module type of struct
  include Devices.Key
  (** @inline *)
end

(** Configuration keys. *)
module Runtime_arg : module type of struct
  include Devices.Runtime_arg
  (** @inline *)
end

(** {2 General mirage devices} *)

type qubesdb

val qubesdb : qubesdb typ
(** For the Qubes target, the Qubes database from which to look up dynamic
    runtime configuration information. *)

val default_qubesdb : qubesdb impl
(** A default qubes database, guessed from the usual valid configurations. *)

(** {2 Sleep} *)

type sleep
(** Abstract type for sleep. *)

val sleep : sleep typ
(** Implementations of the [Mirage_sleep] signature. *)

val default_sleep : sleep impl
(** The default sleep implementation. *)

val no_sleep : sleep impl
(** Disables the sleep implementation. *)

(** {2 Posix time} *)

type ptime
(** Abstract type for POSIX time. *)

val ptime : ptime typ
(** Implementations of the [Mirage_ptime] signature. *)

val default_ptime : ptime impl
(** The default mirage-ptime implementation. *)

val no_ptime : ptime impl
(** Disables the mirage-ptime implementation. *)

val mock_ptime : ptime impl
(** A ptime mock implementation where you can manually set the clock via
    [Mirage_ptime_set]. *)

(** {2 Monotonic time} *)

type mtime
(** Abstract type for monotonic time *)

val mtime : mtime typ
(** Implementations of the [Mirage_mtime] signature. *)

val default_mtime : mtime impl
(** The default mirage-mtime implementation. *)

val no_mtime : mtime impl
(** Disables the mirage-mtime implementation. *)

val mock_mtime : mtime impl
(** A mtime mock implementation where you can manually set the clock via
    [Mirage_mtime_set]. *)

(** {2 Log reporters} *)

type reporter
(** The type for log reporters. *)

val reporter : reporter typ
(** Implementation of the log {!type:reporter} type. *)

val default_reporter : ?level:Logs.level option -> unit -> reporter impl
(** [default_reporter ?level ()] is the log reporter that prints log messages to
    the console, with a timestamp as prefix. [level] is the default log
    threshold. It is [Some Logs.Info] if not specified. *)

val no_reporter : reporter impl
(** [no_reporter] disable log reporting. *)

(** {2 Random} *)

type random
(** Abstract type for random sources. *)

val random : random typ
(** Implementations of the [Mirage_crypto_rng_mirage2] signature. *)

val default_random : random impl
(** Default PRNG device to be used in unikernels. It uses getrandom/getentropy
    on Unix, and a Fortuna PRNG on other targets. *)

val no_random : random impl
(** Disables the random device. *)

(** {2 Block devices} *)

type block
(** Abstract type for raw block device configurations. *)

val block : block typ
(** Implementations of the [Mirage_block.S] signature. *)

val block_of_file : string -> block impl
(** Use the given file as a raw block device. *)

val block_of_xenstore_id : string -> block impl
(** Use the given XenStore ID (ex: [/dev/xvdi1] or [51760]) as a raw block
    device. *)

val ramdisk : string -> block impl
(** Use a ramdisk with the given name. *)

val generic_block :
  ?group:string ->
  ?key:[ `XenstoreId | `BlockFile | `Ramdisk ] value ->
  string ->
  block impl

(** {2 Static key/value stores} *)

type kv_ro
(** Abstract type for read-only key/value store. *)

val kv_ro : kv_ro typ
(** Implementations of the [Mirage_kv.RO] signature. *)

val crunch : string -> kv_ro impl
(** Crunch a directory. The contents of the directory is transformed into OCaml
    code, which is then compiled as part of the unikernel. *)

val tar_kv_ro : block impl -> kv_ro impl
(** [tar_kv_ro block] is a read-only tar archive. *)

val direct_kv_ro : string -> kv_ro impl
(** Direct access to the underlying filesystem as a key/value store for Unix.
    For other backends, this is equivalent to [crunch]. *)

val fat_ro : block impl -> kv_ro impl
(** Use a FAT formatted block device. *)

val generic_kv_ro :
  ?group:string -> ?key:[ `Crunch | `Direct ] value -> string -> kv_ro impl
(** Generic key/value that will choose dynamically between {!direct_kv_ro} and
    {!crunch}. To use a filesystem implementation, try {!kv_ro_of_fs}.

    If no key is provided, a new {!Key.kv_ro} is created with the [group]
    argument. *)

val docteur :
  ?mode:[ `Fast | `Light ] ->
  ?name:string key ->
  ?output:string key ->
  ?analyze:bool runtime_arg ->
  ?branch:string ->
  ?extra_deps:string list ->
  string ->
  kv_ro impl
(** [docteur ?mode ?name ?output ?analyze remote] is a read-only, key-value
    store device. Data is stored on that device using the Git PACK file format,
    version 2. This format has very good compression factors for many similar
    files of relatively small size. For instance, 14Gb of HTML files can be
    compressed into a disk image of 240Mb.

    Unlike {!crunch}, [docteur] produces an external image which means that less
    memory is used to keep and get files. The image can be produced from many
    sources:

    - A local Git repository (like [file://path/to/the/git/repository/])
    - A simple directory (like [file://path/to/a/simple/directory/])
    - A remote Git repository (via SSH, HTTP(S) or TCP/IP as what [git clone]
      expects)

    If you use a Git repository, you can choose a specific branch with the
    [?branch] argument (like [refs/heads/main]). Otherwise, this argument is
    ignored.

    If you use a simple directory, it can be a relative from your unikernel
    project ([relativize://directory]) or an absolute path
    ([file://home/user/directory]).

    If a required file is produced by a [dune] rule, you must notice it via the
    [extra_deps] argument.

    For a Solo5 target, users must {i attach} the image as a block device:

    {[
      $ solo5-hvt --block:<name>=<path-to-the-image> -- unikernel.{hvt,...}
    ]}

    The user is able to specify the name of the block device (default to
    ["docteur"]). The user can also specify the output of [docteur.make], the
    tool which generate the image (default to ["disk.img"]).

    For the Unix target, the program [open] the image at the beginning of the
    process. An integrity check of the image can be done via the [analyze] value
    (defaults to [true]).

    It's possible to use the file-system into 2 modes:

    - [`Light]: any access requires that we reconstruct the path to the
      requested file. That means that we will need to extract a few additional
      objects before the extraction of the requested one. [`Light] does not
      cache anything in memory but it can be slower if the requested file is
      deep in the directory structure.
    - [`Fast]: reconstructs and cache the layout of the directory structure when
      the unikernel starts: it might increase boot-time and bigger memory
      requirements. However, [`Fast] allows the device to decode only the
      requested object so it is faster than the [`Light] mode. *)

type kv_rw
(** Abstract type for read-write key/value store. *)

val kv_rw : kv_rw typ
(** Implementations of the [Mirage_kv.RW] signature. *)

val direct_kv_rw : string -> kv_rw impl
(** Direct access to the underlying filesystem as a key/value store. Only
    available on Unix backends. *)

val kv_rw_mem : unit -> kv_rw impl
(** An in-memory key-value store using [mirage-kv-mem]. *)

val chamelon : program_block_size:int runtime_arg -> block impl -> kv_rw impl
(** [chamelon ~program_block_size] returns a {!kv_rw} filesystem which is an
    implementation of {{:https://github.com/littlefs-project/littlefs} littlefs}
    in OCaml. The [chamelon] device expects a {i block-device}.

    [unikernel.ml]:
    {[
      open Cmdliner

      let program_block_size =
        Arg.(value & opt int 16 & info [ "program-block-size" ])
    ]}
    [config.ml]:
    {[
      let db =
        let program_block_size =
          Runtime_arg.create ~pos:__POS__ "Unikernel.program_block_size"
        in
        let block = block_of_file "db" in
        chamelon ~program_block_size block
      in
    ]}

    For Solo5 targets, you finally can launch the unikernel with:

    {[
      $ solo5-hvt --block:db=db.img unikernel.hvt
    ]}

    The block-device must be well-formed and {i formatted} by the [chamelon]
    tool:

    {[
      $ dd if=/dev/zero of=db.img bs=1M count=1
      $ chamelon format db.img 512
    ]} *)

val tar_kv_rw : block impl -> kv_rw impl
(** [tar_kv_rw block] is a read/write tar archive. Note that the filesystem is
    append-only. That is, files can generally not be removed, [set_partial] only
    works on what is allocated, and there are restrictions on [rename]. *)

val ccm_block :
  ?nonce_len:int -> string option runtime_arg -> block impl -> block impl
(** [ccm_block key block] returns a new block which is a AES-CCM encrypted disk.

    {b Note} also that the available size of an encrypted block is always
    divided by 2 of its real size: a 512M block will only be able to contain
    256M data if it is encrypted.

    You can either use a fresh block device as encrypted storage. This does not
    need any preparation, just using [ccm_block] with the desired [key]. If you
    have an existing disk image that you want to encrypt, you can use the
    [ccmblock] tool given by the [mirage-block-ccm] opam package.

    {[
      $ ccmblock enc -i db.img -k 0x10786d3a9c920d0b3ec80dfaaac557a7 -o edb.img
    ]}

    Accept the key as a runtime argument, in [unikernel.ml]:
    {[
      open Cmdliner

      let aes_ccm_key =
        let doc = "The key of the block device (hex formatted)" in
        Arg.(required & opt (some string) None & info ~doc [ "aes-ccm-key" ])
    ]}

    Then, into you [config.ml], you just need to compose your block device with
    [ccm_block]:

    {[
      let encrypted_block =
        let aes_ccm_key =
          Runtime_arg.create ~pos:__POS__ "Unikernel.aes_ccm_key"
        in
        let block = block_of_file "edb"
        ccm_block aes_ccm_key block
      in
    ]}

    Finally, with Solo5, you can launch your unikernel with that:

    {[
      $ solo5-hvt --block:edb=edb.img \
        --arg="--aes-ccm-key=0x10786d3a9c920d0b3ec80dfaaac557a7" \
        unikernel.hvt
    ]}

    You can finally compose a file-system such as {!chamelon} with this block
    device (and you have a encrypted file-system!):

    {[
      let fs = chamelon ~program_block_size encrypted_block
    ]} *)

(** {2 Network interfaces} *)

type network
(** Abstract type for network configurations. *)

val network : network typ
(** Implementations of the [Mirage_net.S] signature. *)

val default_network : network impl
(** [default_network] is a dynamic network implementation which attempts to do
    something reasonable based on the target. *)

val netif : ?group:string -> string -> network impl
(** A custom network interface. Exposes a {!Runtime_arg.interface} key. *)

(** {2 Ethernet configuration} *)

type ethernet

val ethernet : ethernet typ
(** Implementations of the [Ethernet.S] signature. *)

val etif : network impl -> ethernet impl
[@@ocaml.deprecated "Deprecated. Use [ethif] instead."]
(** [etif net] is the ethernet layer on [net]. *)

val ethif : network impl -> ethernet impl
(** [ethif net] is the ethernet layer on [net]. *)

(** {2 ARP configuration} *)

type arpv4

val arpv4 : arpv4 typ
(** Implementation of the [Arp.S] signature. *)

val arp : ethernet impl -> arpv4 impl
(** ARP implementation provided by the arp library *)

(** {2 IP configuration}

    Implementations of the [Tcpip.Ip.S] signature. *)

type v4
type v6
type v4v6

type 'a ip
(** Abstract type for IP configurations. *)

type ipv4 = v4 ip
type ipv6 = v6 ip
type ipv4v6 = v4v6 ip

val ipv4 : ipv4 typ
(** The [Tcpip.Ip.S] module signature with ipaddr = Ipaddr.V4. *)

val ipv6 : ipv6 typ
(** The [Tcpip.Ip.S] module signature with ipaddr = Ipaddr.V6. *)

val ipv4v6 : ipv4v6 typ
(** The [Tcpip.Ip.S] module signature with ipaddr = Ipaddr.t. *)

val ipv4_of_dhcp : network impl -> ethernet impl -> arpv4 impl -> ipv4 impl
(** Configure the interface via DHCP *)

val create_ipv4 : ?group:string -> ethernet impl -> arpv4 impl -> ipv4 impl
(** Use an IPv4 address Exposes the keys {!Runtime_arg.V4.network} and
    {!Runtime_arg.V4.gateway}. *)

val ipv4_qubes : qubesdb impl -> ethernet impl -> arpv4 impl -> ipv4 impl
(** Use a given initialized QubesDB to look up and configure the appropriate *
    IPv4 interface. *)

val create_ipv6 : ?group:string -> network impl -> ethernet impl -> ipv6 impl
(** Use an IPv6 address. Exposes the keys {!Runtime_arg.V6.network},
    {!Runtime_arg.V6.gateway}. *)

val create_ipv4v6 : ?group:string -> ipv4 impl -> ipv6 impl -> ipv4v6 impl

(** {2 UDP configuration} *)

type 'a udp
type udpv4v6 = v4v6 udp

val udp : 'a udp typ
(** Implementation of the [Tcpip.Udp.S] signature. *)

val udpv4v6 : udpv4v6 typ
val direct_udp : 'a ip impl -> 'a udp impl

(** {2 TCP configuration} *)

type 'a tcp
type tcpv4v6 = v4v6 tcp

val tcp : 'a tcp typ
(** Implementation of the [Tcpip.Tcp.S] signature. *)

val tcpv4v6 : tcpv4v6 typ
val direct_tcp : 'a ip impl -> 'a tcp impl

(** {2 Network stack configuration} *)

(** {3 Dual IPv4 and IPv6} *)

type stackv4v6

val stackv4v6 : stackv4v6 typ
(** Implementation of the [Tcpip.Stack.V4V6] signature. *)

val direct_stackv4v6 :
  ?group:string ->
  ?tcp:tcpv4v6 impl ->
  network impl ->
  ethernet impl ->
  arpv4 impl ->
  ipv4 impl ->
  ipv6 impl ->
  stackv4v6 impl
(** Direct network stack with given ip. *)

val generic_stackv4v6 :
  ?group:string ->
  ?dhcp_key:bool value ->
  ?net_key:[ `OCaml | `Host ] option value ->
  ?ipv4_network:Ipaddr.V4.Prefix.t ->
  ?ipv4_gateway:Ipaddr.V4.t ->
  ?ipv6_network:Ipaddr.V6.Prefix.t ->
  ?ipv6_gateway:Ipaddr.V6.t ->
  ?tcp:tcpv4v6 impl ->
  network impl ->
  stackv4v6 impl
(** Generic stack using a [net] keys: {!Key.net}.

    - If [net] = [host] then the Unix sockets API is used;
    - Else, if [qubes], a special IPv4 stack using the QubesDB is used;
    - Else, if [dhcp] is true, a DHCP client is used for the IPv4 address;
    - Else, an IP stack with a static IP address is used.

    If a key is not provided, it uses {!Key.net} (with the [group] argument) to
    create it. *)

val tcpv4v6_of_stackv4v6 : stackv4v6 impl -> tcpv4v6 impl
(** [tcpv4v6 stackv4v6] is an helper to extract the TCP/IP stack regardless the
    UDP/IP stack expected by some {i devices} such as protocols. *)

(** {2 Resolver configuration} *)

type resolver

val resolver : resolver typ
val resolver_dns : ?ns:string list -> stackv4v6 impl -> resolver impl
val resolver_unix_system : resolver impl

(** {2 Happy-eyeballs} *)

(** Happy-eyeballs is an implementation of RFC 8305 which specifies how to
    connect to a remote host using either IP protocol version 4 or IP protocol
    version 6 from a [stackv4v6] network implementation.

    The given {i device} is able to resolve a remote host {i via} a
    {!dns_client} device and both must share the same [stackv4v6]
    implementation. *)

type happy_eyeballs

val happy_eyeballs : happy_eyeballs typ

val generic_happy_eyeballs :
  ?group:string ->
  ?aaaa_timeout:int64 ->
  ?connect_delay:int64 ->
  ?connect_timeout:int64 ->
  ?resolve_timeout:int64 ->
  ?resolve_retries:int ->
  ?timer_interval:int64 ->
  stackv4v6 impl ->
  happy_eyeballs impl
(** [generic_happy_eyeballs stackv4v6] creates a new happy-eyeballs value which
    is able to connect to a remote host and allocate finally a connected
    {i flow} from the given network implementation [stackv4v6]. However, if you
    want to resolve (DNS resolution) & connect to a remote host, you must
    complete your unikernel with a {!val:generic_dns_client} which upgrade the
    happy-eyeballs stack with a DNS resolution stack.

    This device has several optional arguments of keys for timeouts specified in
    nanoseconds. *)

(** {2 DNS client} *)

(** A DNS client is a module which implements:

    - [getaddrinfo] to request a [query_type]-dependent response to a nameserver
      regarding a domain-name such as the [MX] record.
    - [gethostbyname] to request the [A] regarding a domain-name
    - [gethostbyname6] to request the [AAAA] record regarding a domain-name *)

type dns_client

val dns_client : dns_client typ

val generic_dns_client :
  ?group:string ->
  ?timeout:int64 ->
  ?nameservers:string list ->
  ?cache_size:int ->
  stackv4v6 impl ->
  happy_eyeballs impl ->
  dns_client impl
(** [generic_dns_client stackv4v6 happy_eyeballs] creates a new DNS value which
    is able to resolve domain-name from [nameservers]. It requires a network and
    happy-eyeballs stack to communicate with these nameservers.

    The [nameservers] argument is a list of strings. The format of them is:

    - [udp:ipaddr(:port)?] if you want to communicate with a DNS resolver
      {i via} UDP
    - [tcp:ipaddr(:port)?] if you want to communicate with a DNS resolver
      {i via} TCP/IP
    - [tls:ipaddr(:port)?(!<authenticator>)] if you to communicate with a DNS
      resolver {i via} TLS. You are able to introduce an [<authenticator>]
      (please, follow the documentation about [X509.Authenticator.of_string] to
      get an explanation of its format). Otherwise, by default, we use trust
      anchors from NSS' [certdata.txt]. *)

(** {2 Syslog configuration} *)

(** Syslog exfiltrates log messages (generated by libraries using the [logs]
    library) via a network connection. The log level of the log sources is
    controlled via the {!Mirage_runtime.logs} key. The functionality is provided
    by the [logs-syslog] package. *)

type syslog
(** The type for syslog *)

val syslog : syslog typ
(** Implementation of the {!type:syslog} type. *)

val syslog_udp : ?group:string -> stackv4v6 impl -> syslog impl
(** Emit log messages via UDP. *)

val syslog_tcp : ?group:string -> stackv4v6 impl -> syslog impl
(** Emit log messages via TCP. *)

val syslog_tls : ?group:string -> stackv4v6 impl -> kv_ro impl -> syslog impl
(** Emit log messages via TLS, using the credentials (private key, certificate,
    trust anchor) provided in the KV_RO. *)

(** {2 Monitoring} *)
val monitoring : ?group:string -> stackv4v6 impl -> job impl
(** Monitor metrics to a remote Influx host, also allow adjustments to log
    sources and levels. The provided [stack] should not be publicly reachable.
*)

(** {2 Conduit configuration} *)

type conduit

val conduit : conduit typ
val conduit_direct : ?tls:bool -> stackv4v6 impl -> conduit impl

(** {2 Mimic devices}

    For some implementations which requires to communicate with an external
    resources (such as a webserver or a git server), we must hide the underlying
    implementations that depend on the {i target} (such as the network stack)
    and are necessary for these implementations.

    The aim of [mimic] is to offer first of all the ability to initiate a TCP/IP
    connection independently of the chosen {i target} (see
    {!val:mimic_happy_eyeballs}).

    The resulting {i device} can then be composed with other protocols like TLS,
    Git or HTTP and it is through this resulting {i device} that other devices
    can initiate an internet connection to a peer (like a webserver or a Git
    server). *)

type mimic

val mimic : mimic typ

val mimic_happy_eyeballs :
  stackv4v6 impl -> happy_eyeballs impl -> dns_client impl -> mimic impl
(** [mimic_happy_eyeballs stackv4v6 happy_eyeballs dns_client] creates a device
    which initiate a global {i happy-eyeballs} loop. By this way, an underlying
    instance works to initiate a TCP/IP connection from an IP address or a
    domain-name.

    For the domain-name resolution, we ask the {i happy-eyeballs} instance to
    resolve the given domain-name {i via} its DNS client.

    The resulting {i device} can be used {b and} re-used to for any {i clients}
    which need to initiate a connection (like {!val:alpn_client} or
    {!val:git_tcp}). *)

(** {2 HTTP configuration} *)

type http

val http : http typ

val cohttp_server : conduit impl -> http impl
(** [cohttp_server] starts a Cohttp server. *)

val httpaf_server : conduit impl -> http impl
(** [httpaf_server] starts a http/af server. *)

type http_client

val http_client : http_client typ

val cohttp_client : resolver impl -> conduit impl -> http_client impl
(** [cohttp_server] starts a Cohttp server. *)

type http_server

val http_server : http_server typ

val paf_server : port:int runtime_arg -> tcpv4v6 impl -> http_server impl
(** [paf_server ~port tcpv4v6] creates an instance which will start to
    {i listen} on the given [port]. With this instance and the produced module
    [HTTP_server], the user can initiate:

    - a simple HTTP server
    - a simple HTTPS server (with a TLS configuration)
    - a simple ALPN ([http/1.1] & [h2]) server with TLS

    This is a simple example of how to launch an HTTP server: {b unikernel.ml}

    {[
      open Cmdliner

      let port =
        let doc = "Port of the HTTP service." in
        Arg.(value & opt int 8080 & info [ "p"; "port" ])

      module Make (HTTP_server : Paf_mirage.S with type ipaddr = Ipaddr.t) =
      struct
        let error_handler (_ipaddr, _port) ?request:_ _error _send = ()

        let request_handler :
            HTTP_server.TCP.flow -> Ipaddr.t * int -> Httpaf.Reqd.t -> unit =
         fun _socket (_ipaddr, _port) reqd ->
          let contents = "Hello World!\n" in
          let headers =
            Httpaf.Headers.of_list
              [
                ("content-length", string_of_int (String.length contents));
                ("content-type", "text/plain");
                ("connection", "close");
              ]
          in
          let response = Httpaf.Response.create ~headers `OK in
          Httpaf.Reqd.respond_with_string reqd response contents

        let start http_server port =
          let service =
            HTTP_service.http_service ~error_handler request_handler
          in
          let (`Initialized thread) = HTTP_server.serve service http_server in
          thread
      end
    ]}

    {b config.ml}

    {[
      open Mirage

      let port = Runtime_arg.create ~pos:__POS__ "Unikernel.port"
      let main = main "Unikernel.Make" (http_server @-> job)
      let stackv4v6 = generic_stackv4v6 default_network
      let http_server = paf_server ~port (tcpv4v6_of_stackv4v6 stackv4v6)

      let () =
        register "main"
          ~runtime_args:[ Runtime_arg.v port ]
          [ main $ http_server ]
    ]} *)

type alpn_client
(** Abstract type for ALPN HTTP clients *)

val alpn_client : alpn_client typ

val paf_client : tcpv4v6 impl -> mimic impl -> alpn_client impl
(** [paf_client tcpv4v6 dns] creates an ALPN device which can do HTTP
    ([http/1.1] & [h2]) requests as a HTTP client. The device allocated
    represents values required to initiate a connection to HTTP webservers. The
    user can, then, use the module [Http_mirage_client.request] to communicate
    with HTTP webservers. This is an example of how to use the ALPN devices:

    {b unikernel.ml}

    {[
      module Make (HTTP_client : Http_mirage_client.S) = struct
        let start http =
          Http_mirage_client.request http "https://google.com"
            (fun _response buf str -> Buffer.add_string buf str ; Lwt.return buf)
            (Buffer.create 0x100) >>= function
          | Ok (response, buf) ->
            let body = Buffer.contents buf in
            ...
          | Error _ -> ...
      end
    ]}

    {b config.ml}

    {[
      open Mirage

      let main = main "Unikernel.Make" (alpn_client @-> job)
      let stackv4v6 = generic_stackv4v6 default_network
      let he = generic_happy_eyeballs stack
      let dns = generic_dns_client stack he

      let alpn_client =
        let mimic = mimic_happy_eyeballs stackv4v6 he dns in
        paf_client (tcpv4v6_of_stackv4v6 stackv4v6) mimic

      let () = register "main" [ main $ alpn_client ]
    ]} *)

(** {2 Argv configuration} *)

type argv = Functoria.argv

val argv : argv typ

val default_argv : argv impl
(** [default_argv] is a dynamic argv implementation which attempts to do
    something reasonable based on the target. *)

val no_argv : argv impl
(** [no_argv] Disable command line parsing and set argv to [|""|]. *)

(** {2 Git client configuration} *)

(** Users can connect to a remote Git repository in many ways:

    - TCP/IP
    - HTTP
    - HTTP + TLS
    - SSH

    The devices defined below define these in composable ways. The
    [git_client impl] returned from them can be passed to Git or Irmin in order
    to be able to {i fetch} and {i push} from/into a Git repository.

    The user is able to restrict or enlarge protocol possibilities needed for
    its application. For instance, the user is able to restrict only the SSH
    connection to communicate with a Git repository or the user can handle
    TCP/IP and SSH as possible protocols to communicate with a peer.

    For instance, a device which is able to communicate {i via} TCP/IP and SSH
    can be implemented like:

    {[
      let he = generic_happy_eyeballs stack
      let dns = generic_dns_client stack he

      let git_client =
        let mimic = mimic_happy_eyeballs stackv4v6 he dns in
        let ssh =
          git_ssh ~key ~password (tcpv4v6_of_stackv4v6 stackv4v6) mimic
        in
        let tcp = git_tcp (tcpv4v6_of_stackv4v6 stackv4v6) mimic in
        merge_git_clients ssh tcp
    ]} *)

type git_client
(** The type for devices that implement the Git protocol. *)

val git_client : git_client typ

val merge_git_clients : git_client impl -> git_client impl -> git_client impl
(** [merge_git_clients a b] is a device that can connect to remote Git
    repositories using either the device [a] or the device [b]. *)

val git_tcp : tcpv4v6 impl -> mimic impl -> git_client impl
(** [git_tcp tcpv4v6 dns] is a device able to connect to a remote Git repository
    using TCP/IP. *)

val git_ssh :
  ?group:string ->
  ?authenticator:string ->
  ?key:string ->
  ?password:string ->
  tcpv4v6 impl ->
  mimic impl ->
  git_client impl
(** [git_ssh ?group ?authenticator ?key ?password tcpv4v6 dns] is a device able
    to connect to a remote Git repository using an SSH connection with the given
    private [key] or [password]. The identity of the remote Git repository can
    be verified using [authenticator].

    The format of the private key is: [<type>:<seed or b64 encoded>]. [<type>]
    can be [rsa] or [ed25519] and, if the type is RSA, we expect the {b seed} of
    the private key. Otherwise (if the type is Ed25519), we expect the
    b64-encoded private key.

    The format of the authenticator is [SHA256:<b64-encoded-public-key>], the
    output of:

    {[
      $ ssh-keygen -lf <(ssh-keyscan -t rsa|ed25519 remote 2>/dev/null)
    ]} *)

val git_http :
  ?group:string ->
  ?authenticator:string ->
  ?headers:(string * string) list ->
  tcpv4v6 impl ->
  mimic impl ->
  git_client impl
(** [git_http ?group ?authenticator ?headers tcpv4v6 dns] is a device able to
    connect to a remote Git repository via an HTTP(S) connection, using the
    provided HTTP [headers]. The identity of the remote Git repository can be
    verified using [authenticator].

    The format of it is:

    - [none] no authentication
    - key(:<hash>)?:<b64-encoded fingerprint> to authenticate via the key
      fingerprint
    - cert(:<hash>)?:<b64-encoded fingerprint> to authenticate via the cert
      fingerprint
    - trust-anchor(:<der-encoded cert>)+ to authenticate via a list of
      certificates
    - By default, we use X.509 trust anchors extracted from Mozilla's NSS *)

(** {2 Other devices} *)

val job : job typ
(** [job] is the combinator for representing main tasks. *)

val noop : job impl
(** [noop] is a job that does nothing, has no dependency and returns [()] *)

val runtime_args : argv impl -> job impl
(** [runtime_args argv] is a job that loads argv. *)

(** {2 Application registering} *)

val register :
  ?argv:argv impl ->
  ?reporter:reporter impl ->
  ?sleep:sleep impl ->
  ?ptime:ptime impl ->
  ?mtime:mtime impl ->
  ?random:random impl ->
  ?src:[ `Auto | `None | `Some of string ] ->
  string ->
  job impl list ->
  unit
(** [register ~argv ~reporter ~src name jobs] registers the application named by
    [name] which will executes the given [jobs].

    @param argv
      Configure command-line argument parsing. The default parser is
      {!default_argv}. To disable command-line parsing, use {!no_argv}.
    @param reporter
      Configure logging. The default log reporter is {!default_reporter}. To
      disable logging, use {!no_reporter}.
    @param sleep
      Configure the sleep. The default is {!default_sleep}. To disable the
      timer, use {!no_sleep}.
    @param ptime
      Configure the POSIX clock. The default is {!default_ptime}. To disable the
      POSIX clock, use {!no_ptime}.
    @param mtime
      Configure the monotonic clock. The default is {!default_mtime}. To disable
      the monotonic clock, use {!no_mtime}.
    @param random
      Configure the random number generator. The default is {!default_random}.
      To disable the random device, use {!no_random}.
    @param src
      The source to use in the generated opam file. If [`None] no source is
      output. If [`Some mysource] the string [mysource] is used as the source.
      If [`Auto] (default) the is guessed from the VCS information. *)

module Type = Functoria.Type
module Impl = Functoria.Impl
module Info = Functoria.Info
module Dune = Functoria.Dune
module Action = Functoria.Action
module Context = Functoria.Context

val connect_err : string -> int -> 'a

module Project : sig
  val dune : Info.t -> Dune.stanza list
  val configure : Info.t -> unit Action.t
end

module Tool : sig
  val run : unit -> unit
end
