slack: cache users.lookupByEmail answers

lib/action.ml

@@ -102,7 +102,7 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) = struct
       let%lwt () = State.set_repo_pipeline_status ctx.state repo.url ~pipeline ~branches ~status:current_status in
       let%lwt direct_message =
         if notify_dm then begin
-          match%lwt Slack_api.lookup_user ~ctx ~cfg ~email:n.commit.commit.author.email with
+          match%lwt Slack_api.lookup_user ~ctx ~cfg ~email:n.commit.commit.author.email () with
           (* To send a DM, channel parameter is set to the user id of the recipient *)
           | Ok res -> Lwt.return [ res.user.id ]
           | Error e ->

lib/api.ml

@@ -18,7 +18,14 @@ module type Github = sig
 end
 
 module type Slack = sig
-  val lookup_user : ctx:Context.t -> cfg:Config_t.config -> email:string -> lookup_user_res slack_response Lwt.t
+  val lookup_user
+    :  ?cache:[ `Use | `Refresh ] ->
+    ctx:Context.t ->
+    cfg:Config_t.config ->
+    email:string ->
+    unit ->
+    lookup_user_res slack_response Lwt.t
+
   val send_notification : ctx:Context.t -> msg:post_message_req -> unit slack_response Lwt.t
 
   val send_chat_unfurl

lib/api_local.ml

@@ -54,7 +54,7 @@ end
 
 (** The base implementation for local check payload debugging and mocking tests *)
 module Slack_base : Api.Slack = struct
-  let lookup_user ~ctx:_ ~cfg:_ ~email:_ = Lwt.return @@ Error "undefined for local setup"
+  let lookup_user ?cache:_ ~ctx:_ ~cfg:_ ~email:_ () = Lwt.return @@ Error "undefined for local setup"
   let send_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"
@@ -64,7 +64,7 @@ end
 module Slack : Api.Slack = struct
   include Slack_base
 
-  let lookup_user ~ctx:_ ~(cfg : Config_t.config) ~email =
+  let lookup_user ?cache:_ ~ctx:_ ~(cfg : Config_t.config) ~email () =
     let email = List.Assoc.find cfg.user_mappings ~equal:String.equal email |> Option.value ~default:email in
     let mock_user =
       {

lib/api_remote.ml

@@ -117,14 +117,30 @@ module Slack : Api.Slack = struct
     (* must read whole response to update lexer state *)
     ignore (Slack_j.read_ok_res s l)
 
-  (** [lookup_user cfg email] queries slack for a user profile with [email] *)
-  let lookup_user ~(ctx : Context.t) ~(cfg : Config_t.config) ~email =
+  let lookup_user_cache = Stdlib.Hashtbl.create 50
+
+  let lookup_user' ~(ctx : Context.t) ~(cfg : Config_t.config) ~email () =
     (* Check if config holds the Github to Slack email mapping  *)
     let email = List.Assoc.find cfg.user_mappings ~equal:String.equal email |> Option.value ~default:email in
     let url_args = Web.make_url_args [ "email", email ] in
-    request_token_auth ~name:"lookup user by email" ~ctx `GET
-      (sprintf "users.lookupByEmail?%s" url_args)
-      Slack_j.read_lookup_user_res
+    match%lwt
+      request_token_auth ~name:"lookup user by email" ~ctx `GET
+        (sprintf "users.lookupByEmail?%s" url_args)
+        Slack_j.read_lookup_user_res
+    with
+    | Error _ as e -> Lwt.return e
+    | Ok user ->
+      Stdlib.Hashtbl.replace lookup_user_cache email user;
+      Lwt.return_ok user
+
+  (** [lookup_user cfg email] queries slack for a user profile with [email] *)
+  let lookup_user ?(cache : [ `Use | `Refresh ] = `Use) ~(ctx : Context.t) ~(cfg : Config_t.config) ~email () =
+    match cache with
+    | `Refresh -> lookup_user' ~ctx ~cfg ~email ()
+    | `Use ->
+    match Stdlib.Hashtbl.find_opt lookup_user_cache email with
+    | Some user -> Lwt.return_ok user
+    | None -> lookup_user' ~ctx ~cfg ~email ()
 
   (** [send_notification ctx msg] notifies [msg.channel] with the payload [msg];
       uses web API with access token if available, or with webhook otherwise *)