action: use slack lib implementations

lib/action.ml

@@ -1,6 +1,8 @@
 open Devkit
 open Base
 open Slack
+module Slack_t = Slack_lib.Slack_t
+module Slack_j = Slack_lib.Slack_j
 open Config_t
 open Common
 open Github_j
@@ -291,12 +293,12 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) = struct
       | New_message (msg : Slack_t.post_message_req) ->
         ( match%lwt Slack_api.send_notification ~ctx ~msg with
         | Ok res -> update_comment_mapping res.ts
-        | Error e -> action_error e
+        | Error e -> action_error (Slack_j.string_of_slack_api_error e)
         )
       | Update_message msg ->
         ( match%lwt Slack_api.update_notification ~ctx ~msg with
         | Ok () -> Lwt.return_unit
-        | Error e -> action_error e
+        | Error e -> action_error (Slack_j.string_of_slack_api_error e)
         )
     in
 
@@ -421,7 +423,7 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) = struct
         in
         Lwt.return_some user_id
       | Error msg ->
-        log#warn "failed to query slack auth.test : %s" msg;
+        log#warn "failed to query slack auth.test : %s" (Slack_j.string_of_slack_api_error msg);
         Lwt.return_none
     in
     let process link =
@@ -430,7 +432,7 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) = struct
         =
         match api_result with
         | Error _ -> Lwt.return_none
-        | Ok item -> Lwt.return_some @@ (link, populate repo item)
+        | Ok item -> Lwt.return_some @@ (link, Slack_t.Message_attachment (populate repo item))
       in
       match Github.gh_link_of_string link with
       | None -> Lwt.return_none
@@ -459,27 +461,37 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) = struct
       Lwt.return "ignored: is bot user"
     else begin
       let links = List.map event.links ~f:(fun l -> l.url) in
-      let%lwt unfurls = List.map links ~f:process |> Lwt.all |> Lwt.map List.filter_opt |> Lwt.map StringMap.of_list in
-      if Map.is_empty unfurls then Lwt.return "ignored: no links to unfurl"
+      let%lwt unfurls = List.map links ~f:process |> Lwt.all |> Lwt.map List.filter_opt in
+      if List.length unfurls = 0 then Lwt.return "ignored: no links to unfurl"
       else begin
         match%lwt Slack_api.send_chat_unfurl ~ctx ~channel:event.channel ~ts:event.message_ts ~unfurls () with
         | Ok () -> Lwt.return "ok"
         | Error e ->
-          log#error "%s" e;
+          log#error "%s" (Slack_j.string_of_slack_api_error e);
           Lwt.return "ignored: failed to unfurl links"
       end
     end
 
   let process_slack_event (ctx : Context.t) headers body =
-    let secrets = Context.get_secrets_exn ctx in
-    match Slack_j.event_notification_of_string body with
-    | Url_verification payload -> Lwt.return payload.challenge
-    | Event_callback notification ->
-    match Slack.validate_signature ?signing_key:secrets.slack_signing_secret ~headers body with
-    | Error e -> action_error e
-    | Ok () ->
-    match notification.event with
-    | Link_shared event -> process_link_shared_event ctx event
+    let event_handler = function
+      | Slack_t.Link_shared event ->
+        Lwt.async (fun () ->
+          try%lwt
+            let%lwt (_result : string) = process_link_shared_event ctx event in
+            Lwt.return_unit
+          with exn ->
+            log#error ~exn "fatal error while handling request: %s" body;
+            Lwt.return_unit
+        );
+        log#debug "OK-ed Slack";
+        Lwt.return_ok ""
+      | _ -> Lwt.return_ok ""
+    in
+    match%lwt Slack_lib.Utils.process_slack_event ctx.slack_ctx headers body ~event_handler with
+    | Ok res -> Lwt.return res
+    | Error e ->
+      log#error "errored: %s, while processing: %s" e body;
+      Lwt.return ""
 
   (** debugging endpoint to return current in-memory repo config *)
   let print_config (ctx : Context.t) repo_url =

lib/api.ml

@@ -1,6 +1,5 @@
 open Base
 open Github_t
-open Slack_t
 
 module type Github = sig
   val get_config : ctx:Context.t -> repo:repository -> (Config_t.config, string) Result.t Lwt.t
@@ -18,14 +17,16 @@ module type Github = sig
 end
 
 module type Slack = sig
+  open Slack_lib.Slack_t
+
   val send_notification : ctx:Context.t -> msg:post_message_req -> post_message_res slack_response Lwt.t
   val update_notification : ctx:Context.t -> msg:update_message_req -> unit slack_response Lwt.t
 
   val send_chat_unfurl
     :  ctx:Context.t ->
     channel:string ->
     ts:string ->
-    unfurls:message_attachment Common.StringMap.t ->
+    unfurls:(string * unfurl) list ->
     unit ->
     unit slack_response Lwt.t
 

lib/api_local.ml

@@ -2,7 +2,12 @@ open Base
 open Common
 open Devkit
 open Printf
+module Slack_j = Slack_lib.Slack_j
+module Slack_t = Slack_lib.Slack_t
 
+exception Test_setup_failure of string
+
+let test_setup_failure fmt = ksprintf (fun msg -> raise (Test_setup_failure msg)) fmt
 let cwd = Caml.Sys.getcwd ()
 let cache_dir = Caml.Filename.concat cwd "github-api-cache"
 
@@ -52,10 +57,10 @@ end
 
 (** The base implementation for local check payload debugging and mocking tests *)
 module Slack_base : Api.Slack = struct
-  let send_notification ~ctx:_ ~msg:_ = Lwt.return @@ Error "undefined for local setup"
-  let update_notification ~ctx:_ ~msg:_ = Lwt.return @@ Error "undefined for local setup"
-  let send_chat_unfurl ~ctx:_ ~channel:_ ~ts:_ ~unfurls:_ () = Lwt.return @@ Error "undefined for local setup"
-  let send_auth_test ~ctx:_ () = Lwt.return @@ Error "undefined for local setup"
+  let send_notification ~ctx:_ ~msg:_ = test_setup_failure "undefined for local setup"
+  let update_notification ~ctx:_ ~msg:_ = test_setup_failure "undefined for local setup"
+  let send_chat_unfurl ~ctx:_ ~channel:_ ~ts:_ ~unfurls:_ () = test_setup_failure "undefined for local setup"
+  let send_auth_test ~ctx:_ () = test_setup_failure "undefined for local setup"
 end
 
 (** Module for mocking test requests to slack--will output on Stdio *)
@@ -110,11 +115,9 @@ module Slack_simple : Api.Slack = struct
       );
     Lwt.return @@ Ok ()
 
-  let send_chat_unfurl ~ctx:_ ~channel ~ts:_ ~(unfurls : Slack_t.message_attachment Common.StringMap.t) () =
-    Stdio.printf "will unfurl in #%s\n" channel;
-    let unfurl_text = List.map (StringMap.to_list unfurls) ~f:(fun (_, unfurl) -> unfurl.text) in
-    Stdio.printf "%s\n" (String.concat ~sep:"\n" (List.filter_opt unfurl_text));
-    Lwt.return @@ Ok ()
+  let send_chat_unfurl ~(ctx : Context.t) ~channel ~ts ~(unfurls : (string * Slack_t.unfurl) list) () =
+    let req = Slack_j.{ channel; ts; unfurls } in
+    Slack_lib.Api_local.send_chat_unfurl ~ctx:ctx.slack_ctx ~req
 
   let send_auth_test ~ctx:_ () =
     Lwt.return
@@ -145,13 +148,9 @@ module Slack_json : Api.Slack = struct
     log#info "%s" json;
     Lwt.return @@ Ok ()
 
-  let send_chat_unfurl ~ctx:_ ~channel ~ts:_ ~(unfurls : Slack_t.message_attachment Common.StringMap.t) () =
-    log#info "will notify %s" channel;
-    let json = List.map (StringMap.to_list unfurls) ~f:(fun (_, unfurl) -> Slack_j.string_of_unfurl unfurl) in
-    let url = Uri.of_string "https://slack.com/api/chat.unfurl" in
-    log#info "%s" (Uri.to_string url);
-    log#info "%s" (String.concat ~sep:";\n" json);
-    Lwt.return @@ Ok ()
+  let send_chat_unfurl ~(ctx : Context.t) ~channel ~ts ~(unfurls : (string * Slack_t.unfurl) list) () =
+    let req = Slack_j.{ channel; ts; unfurls } in
+    Slack_lib.Api_local.send_chat_unfurl ~ctx:ctx.slack_ctx ~req
 
   let send_auth_test ~ctx:_ () =
     Lwt.return

lib/api_remote.ml

@@ -2,6 +2,8 @@ open Base
 open Printf
 open Devkit
 open Common
+module Slack_t = Slack_lib.Slack_t
+module Slack_j = Slack_lib.Slack_j
 
 module Github : Api.Github = struct
   let commits_url ~(repo : Github_t.repository) ~sha =
@@ -93,30 +95,6 @@ module Slack : Api.Slack = struct
   let log = Log.from "slack"
   let query_error_msg url e = sprintf "error while querying %s: %s" url e
 
-  let slack_api_request ?headers ?body meth url read =
-    match%lwt http_request ?headers ?body meth url with
-    | Error e -> Lwt.return @@ Error (query_error_msg 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)
-
-  let request_token_auth ~name ?headers ?body ~ctx meth path read =
-    log#info "%s: starting request" name;
-    let secrets = Context.get_secrets_exn ctx in
-    match secrets.slack_access_token with
-    | None -> Lwt.return @@ fmt_error "%s: failed to retrieve Slack access token" name
-    | Some access_token ->
-      let headers = bearer_token_header access_token :: Option.value ~default:[] headers in
-      let url = sprintf "https://slack.com/api/%s" path in
-      ( match%lwt slack_api_request ?body ~headers meth url read with
-      | Ok res -> Lwt.return @@ Ok res
-      | Error e -> Lwt.return @@ fmt_error "%s: failure : %s" name e
-      )
-
-  let read_unit s l =
-    (* must read whole response to update lexer state *)
-    ignore (Slack_j.read_ok_res s l)
-
   let webhook_channel_request (ctx : Context.t) ~channel ~build_error read body =
     match Context.hook_of_channel ctx channel with
     | Some url ->
@@ -138,8 +116,7 @@ module Slack : Api.Slack = struct
     | Ok res -> Lwt.return_ok res
     | Error e ->
       log#warn "failed to run webhook call: %s" e;
-      request_token_auth ~name:"post message to channel" ~body ~ctx `POST "chat.postMessage"
-        Slack_j.read_post_message_res
+      Slack_lib.Api_remote.send_message ~ctx:ctx.slack_ctx ~msg
 
   (** [update_notification ctx msg] update a message at [msg.ts] in [msg.channel]
       with the payload [msg]; uses web API with access token if available, or with
@@ -156,15 +133,14 @@ module Slack : Api.Slack = struct
     | Ok (_res : Slack_t.update_message_res) -> Lwt.return_ok ()
     | Error e ->
       log#warn "failed to run webhook call: %s" e;
-      request_token_auth ~name:"update message in channel" ~body ~ctx `POST "chat.update" read_unit
+      ( match%lwt Slack_lib.Api_remote.update_message ~ctx:ctx.slack_ctx ~msg with
+      | Ok (_res : Slack_t.update_message_res) -> Lwt.return_ok ()
+      | Error e -> Lwt.return_error e
+      )
 
   let send_chat_unfurl ~(ctx : Context.t) ~channel ~ts ~unfurls () =
     let req = Slack_j.{ channel; ts; unfurls } in
-    let data = Slack_j.string_of_chat_unfurl_req req in
-    request_token_auth ~name:"unfurl slack links"
-      ~body:(`Raw ("application/json", data))
-      ~ctx `POST "chat.unfurl" read_unit
+    Slack_lib.Api_remote.send_chat_unfurl ~ctx:ctx.slack_ctx ~req
 
-  let send_auth_test ~(ctx : Context.t) () =
-    request_token_auth ~name:"retrieve bot information" ~ctx `POST "auth.test" Slack_j.read_auth_test_res
+  let send_auth_test ~(ctx : Context.t) = Slack_lib.Api_remote.send_auth_test ~ctx:ctx.slack_ctx
 end

lib/context.ml

@@ -13,19 +13,21 @@ type t = {
   mutable secrets : Config_t.secrets option;
   config : Config_t.config Stringtbl.t;
   state : State.t;
+  slack_ctx : Slack_lib.Context.t;
 }
 
 let default_config_filename = "monorobot.json"
 let default_secrets_filepath = "secrets.json"
 
-let make ?config_filename ?secrets_filepath ?state_filepath () =
+let make ?(config_filename = default_config_filename) ?(secrets_filepath = default_secrets_filepath) ?state_filepath () =
   {
-    config_filename = Option.value config_filename ~default:default_config_filename;
-    secrets_filepath = Option.value secrets_filepath ~default:default_secrets_filepath;
+    config_filename;
+    secrets_filepath;
     state_filepath;
     secrets = None;
     config = Stringtbl.empty ();
     state = State.empty ();
+    slack_ctx = Slack_lib.Context.get_ctx ~secrets_path:secrets_filepath ~ua:"monorobot" ();
   }
 
 let get_secrets_exn ctx =

lib/dune

@@ -1,11 +1,34 @@
 (library
  (name lib)
- (libraries atdgen atdgen-runtime base base64 base.caml biniou cstruct curl curl.lwt
-   devkit devkit.core extlib hex lwt lwt.unix nocrypto omd re2 sexplib0 stdio uri
-   yojson)
+ (libraries
+  atdgen
+  atdgen-runtime
+  base
+  base64
+  base.caml
+  biniou
+  cstruct
+  curl
+  curl.lwt
+  devkit
+  devkit.core
+  extlib
+  hex
+  lwt
+  lwt.unix
+  nocrypto
+  omd
+  re2
+  sexplib0
+  slack.lib
+  stdio
+  uri
+  yojson)
  (preprocess
   (pps lwt_ppx)))
 
+(vendored_dirs slack)
+
 (rule
  (targets common_t.ml common_t.mli)
  (deps common.atd)
@@ -30,18 +53,6 @@
  (action
   (run atdgen -j -j-std %{deps})))
 
-(rule
- (targets slack_t.ml slack_t.mli)
- (deps slack.atd)
- (action
-  (run atdgen -t %{deps})))
-
-(rule
- (targets slack_j.ml slack_j.mli)
- (deps slack.atd)
- (action
-  (run atdgen -j -j-std %{deps})))
-
 (rule
  (targets rule_t.ml rule_t.mli)
  (deps rule.atd)

lib/mrkdwn.ml

@@ -1,14 +1,7 @@
 open Omd
 open Base
 
-(* https://api.slack.com/reference/surfaces/formatting#escaping *)
-let escape_mrkdwn =
-  String.concat_map ~f:(function
-    | '<' -> "&lt;"
-    | '>' -> "&gt;"
-    | '&' -> "&amp;"
-    | c -> String.make 1 c
-    )
+let escape_mrkdwn = Slack_lib.Mrkdwn.escape_mrkdwn
 
 (** Translates omd AST to a Slack mrkdwn string. Code heavily adapted
     from omd 1.3.1 source.