slack: add auth.test endpoint with atd adapter

Author: yasunariw

lib/api.ml

@@ -16,4 +16,6 @@ module type Slack = sig
   val send_notification : ctx:Context.t -> msg:post_message_req -> (unit, string) Result.t Lwt.t
 
   val send_chat_unfurl : ctx:Context.t -> chat_unfurl_req -> (unit, string) Result.t Lwt.t
+
+  val send_auth_test : ctx:Context.t -> unit -> auth_test_res slack_response Lwt.t
 end

lib/api_local.ml

@@ -28,6 +28,8 @@ module Slack_base : Api.Slack = struct
   let send_notification ~ctx:_ ~msg:_ = Lwt.return @@ Error "undefined for local setup"
 
   let send_chat_unfurl ~ctx:_ _ = Lwt.return @@ Error "undefined for local setup"
+
+  let send_auth_test ~ctx:_ () = Lwt.return @@ Error "undefined for local setup"
 end
 
 module Slack : Api.Slack = struct

lib/api_remote.ml

@@ -67,6 +67,11 @@ end
 module Slack : Api.Slack = struct
   let log = Log.from "slack"
 
+  let slack_http_request ?headers ?body meth url read =
+    match%lwt http_request ?headers ?body meth url with
+    | Error e -> Lwt.return @@ Error (sprintf "error while querying %s: %s" url e)
+    | Ok s -> Lwt.return @@ Slack_j.slack_response_of_string read s
+
   let bearer_token_header access_token = sprintf "Authorization: Bearer %s" (Uri.pct_encode access_token)
 
   (** `send_notification ctx msg` notifies `msg.channel` with the payload `msg`;
@@ -123,4 +128,17 @@ module Slack : Api.Slack = struct
         )
       | Error e -> Lwt.return @@ fmt_error "error while querying %s: %s\nfailed to unfurl Slack links" url e
       )
+
+  let send_auth_test ~(ctx : Context.t) () =
+    log#info "retrieving bot information";
+    let secrets = Context.get_secrets_exn ctx in
+    match secrets.slack_access_token with
+    | None -> Lwt.return @@ Error "failed to retrieve Slack access token"
+    | Some access_token ->
+      let url = "https://slack.com/api/auth.test" in
+      let headers = [ bearer_token_header access_token ] in
+      ( match%lwt slack_http_request ~headers `GET url Slack_j.read_auth_test_res with
+      | Ok res -> Lwt.return @@ Ok res
+      | Error e -> Lwt.return @@ Error (sprintf "%s\nfailed to retrieve Slack auth info" e)
+      )
 end

lib/atd_adapters.ml

@@ -46,3 +46,28 @@ module Branch_filters_adapter = List_or_default_field.Make (struct
 
   let default_value = `List []
 end)
+
+module Slack_response_adapter : Atdgen_runtime.Json_adapter.S = struct
+  let normalize (x : Yojson.Safe.t) =
+    match x with
+    | `Assoc fields ->
+      begin
+        match List.assoc "ok" fields with
+        | `Bool true -> `List [ `String "Ok"; x ]
+        | `Bool false ->
+          begin
+            match List.assoc "error" fields with
+            | `String msg -> `List [ `String "Error"; `String msg ]
+            | _ -> x
+          end
+        | _ | (exception Not_found) -> x
+      end
+    | _ -> x
+
+  let restore (x : Yojson.Safe.t) =
+    let mk_fields ok fields = ("ok", `Bool ok) :: List.filter (fun (k, _) -> k <> "ok") fields in
+    match x with
+    | `List [ `String "Ok"; `Assoc fields ] -> `Assoc (mk_fields true fields)
+    | `List [ `String "Error"; `String msg ] -> `Assoc (mk_fields false [ "error", `String msg ])
+    | _ -> x
+end

lib/slack.atd

@@ -118,3 +118,19 @@ type chat_unfurl_res = {
   ok: bool;
   ?error: string option;
 }
+
+type auth_test_res = {
+  url: string;
+  team: string;
+  user: string;
+  team_id: string;
+  user_id: string;
+}
+
+type ('ok, 'err) http_response <ocaml predef module="Base.Result" t="t"> = [
+  | Ok of 'ok
+  | Error of 'err
+] <ocaml repr="classic">
+
+type 'ok slack_response = ('ok, string) http_response
+  <json adapter.ocaml="Atd_adapters.Slack_response_adapter">