package current_docker

  1. Overview
  2. Docs

Source file peek.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
open Lwt.Infix

type t = No_context

let ( >>!= ) = Lwt_result.bind

module Key = struct
  type t = {
    docker_context : string option;
    arch: string;
    os: string;
    tag : string;
  } [@@deriving to_yojson]

  let cmd { docker_context; tag; _ } = Cmd.docker ~docker_context ["manifest"; "inspect"; "--"; tag]

  let digest t = Yojson.Safe.to_string (to_yojson t)
end

module Value = Current.String

let id = "docker-peek"

let build No_context job key =
  Current.Job.start job ~level:Current.Level.Mostly_harmless >>= fun () ->
  let { Key.docker_context = _; tag; arch; os } = key in
  Prometheus.Gauge.inc_one Metrics.docker_peek_events;
  Current.Process.check_output ~cancellable:true ~job (Key.cmd key) >>!= (fun manifest ->
    match Pull.get_digest_from_manifest manifest ~arch ~os with
    | Error _ as e -> Lwt.return e
    | Ok hash ->
      Current.Job.log job "Got %S" hash;
      Lwt_result.return (tag ^ "@" ^ hash))
  >|= (fun res -> Prometheus.Gauge.dec_one Metrics.docker_peek_events; res)

let pp f key = Cmd.pp f (Key.cmd key)

let auto_cancel = true