package current-albatross-deployer

  1. Overview
  2. Docs

Source file config.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
module Docker = Current_docker.Default

(* overrides *)
module Ipaddr = struct
  module V4 = struct
    include Ipaddr.V4

    let of_yojson = function
      | `String v -> of_string v |> Result.map_error (fun (`Msg m) -> m)
      | _ -> Error "type error"

    let to_yojson v = `String (to_string v)
  end
end

module Pre = struct
  type t = {
    service : string;
    unikernel : Unikernel.t;
    args : Ipaddr.V4.t -> string list;
    memory : int;
    network : string;
  }

  let value_digest { unikernel; args; memory; network; _ } =
    let args = args (Ipaddr.V4.of_string_exn "0.0.0.0") in
    Fmt.str "%s|%a|%d|%s"
      (Unikernel.digest unikernel)
      Fmt.(list ~sep:sp string)
      args memory network
    |> Digest.string |> Digest.to_hex

  let id t =
    let v = value_digest t in
    let v = String.sub v 0 (min 10 (String.length v)) in
    t.service ^ "." ^ v
end

type t = {
  service : string;
  unikernel : Unikernel.t;
  args : string list;
  id : string;
  ip : Ipaddr.V4.t;
  memory : int;
  network : string;
}
[@@deriving yojson]

let v (pre : Pre.t) ip =
  {
    service = pre.service;
    unikernel = pre.unikernel;
    args = pre.args ip;
    id = Pre.id pre;
    ip;
    memory = pre.memory;
    network = pre.network;
  }