package current_github

  1. Overview
  2. Docs

Source file current_github.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

module Repo_id = Repo_id
module Api = Api
module App = App
module Installation = Installation
module Auth = Auth

module Metrics = struct
  open Prometheus

  let namespace = "ocurrent"
  let subsystem = "github"

  let webhook_events_total =
    let help = "Incoming webhook events" in
    Counter.v_label ~label_name:"event" ~help ~namespace ~subsystem "webhook_events_total"
end

let webhook = object
  inherit Current_web.Resource.t

  method! post_raw _site req body =
    Log.info (fun f -> f "input_webhook: %a" Cohttp_lwt.Request.pp_hum req);
    let headers = Cohttp.Request.headers req in
    let event = Cohttp.Header.get headers "X-GitHub-Event" in
    Log.info (fun f -> f "Got GitHub event %a" Fmt.(option ~none:(any "NONE") (quote string)) event);
    Prometheus.Counter.inc_one (Metrics.webhook_events_total (Option.value event ~default:"NONE"));
    Cohttp_lwt.Body.to_string body >|= Yojson.Safe.from_string >>= fun body ->
    begin match event with
      | Some "installation_repositories" -> Installation.input_installation_repositories_webhook ()
      | Some "installation" -> App.input_installation_webhook ()
      | Some ("pull_request" | "push" | "create") -> Api.input_webhook body
      | Some x -> Log.warn (fun f -> f "Unknown GitHub event type %S" x)
      | None -> Log.warn (fun f -> f "Missing GitHub event type in webhook!")
    end;
    Cohttp_lwt_unix.Server.respond_string ~status:`OK ~body:"OK" ()
end