Slack: looking up users

urweb · Jun 25, 2020 · ada961b · ada961b
1 parent f170903
commit ada961b
Show file tree

Hide file tree

Showing 3 changed files with 169 additions and 8 deletions.
diff --git a/examples/slackDemo.ur b/examples/slackDemo.ur
@@ -8,9 +8,12 @@ fun postMessage ch text =
 fun channel ch =
     text <- source "";
     ms <- S.Conversations.history ch;
+    ms <- List.mapM (fn m =>
+                        user <- S.Users.info m.User;
+                        return (user.Nam, user.RealName, m.Text)) ms;
     return <xml><body>
       <ol>
-        {List.mapX (fn m => <xml><li>{[m.User]}: {[m.Text]}</li></xml>) ms}
+        {List.mapX (fn (user, rname, text) => <xml><li>{[user]} <i>({[rname]})</i>: {[text]}</li></xml>) ms}
       </ol>
       <hr/>
       Post message: <ctextbox source={text}/> <button value="Go" onclick={fn _ => text <- get text; rpc (postMessage ch text); redirect (url (channel ch))}/>

diff --git a/src/ur/slack.ur b/src/ur/slack.ur
@@ -140,6 +140,101 @@ val _ : json message = json_record_withOptional
                             PinnedTo = "pinned_to",
                             Reactions = "reactions"}
 
+type profile = {
+     Title : string,
+     Phone : string,
+     Skype : string,
+     RealName : string,
+     RealNameNormalized : string,
+     DisplayName : string,
+     DisplayNameNormalized : string,
+     StatusText : string,
+     StatusEmoji : string,
+     StatusExpiration : time,
+     AvatarHash : string,
+     FirstName : option string,
+     LastName : option string,
+     Email : option string,
+     ImageOriginal : option string,
+     Image24 : option string,
+     Image32 : option string,
+     Image48 : option string,
+     Image72 : option string,
+     Image192 : option string,
+     Image512 : option string,
+     Team : string
+}
+val _ : json profile = json_record_withOptional
+                           {Title = "title",
+                            Phone = "phone",
+                            Skype = "skype",
+                            RealName = "real_name",
+                            RealNameNormalized = "real_name_normalized",
+                            DisplayName = "display_name",
+                            DisplayNameNormalized = "display_name_normalized",
+                            StatusText = "status_text",
+                            StatusEmoji = "status_emoji",
+                            StatusExpiration = "status_expiration",
+                            AvatarHash = "avatar_hash",
+                            Team = "team"}
+                           {Email = "email",
+                            FirstName = "first_name",
+                            LastName = "last_name",
+                            ImageOriginal = "image_original",
+                            Image24 = "image_24",
+                            Image32 = "image_32",
+                            Image48 = "image_48",
+                            Image72 = "image_72",
+                            Image192 = "image_192",
+                            Image512 = "image_512"}
+
+type user = {
+     Id : string,
+     TeamId : string,
+     Nam : string,
+     Deleted : bool,
+     Color : string,
+     RealName : string,
+     Tz : string,
+     TzLabel : string,
+     TzOffset : int,
+     Profile : profile,
+     IsAdmin : bool,
+     IsOwner : bool,
+     IsPrimaryOwner : bool,
+     IsRestricted : bool,
+     IsUltraRestricted : bool,
+     IsBot : bool,
+     IsStranger : option bool,
+     Updated : time,
+     IsAppUser : bool,
+     IsInvitedUser : option bool,
+     Has2fa : option bool,
+     Locale : option string
+}
+val _ : json user = json_record_withOptional
+                        {Id = "id",
+                         TeamId = "team_id",
+                         Nam = "name",
+                         Deleted = "deleted",
+                         Color = "color",
+                         RealName = "real_name",
+                         Tz = "tz",
+                         TzLabel = "tz_label",
+                         TzOffset = "tz_offset",
+                         Profile = "profile",
+                         IsAdmin = "is_admin",
+                         IsOwner = "is_owner",
+                         IsPrimaryOwner = "is_primary_owner",
+                         IsRestricted = "is_restricted",
+                         IsUltraRestricted = "is_ultra_restricted",
+                         IsBot = "is_bot",
+                         Updated = "updated",
+                         IsAppUser = "is_app_user"}
+                        {Has2fa = "has_2fa",
+                         IsInvitedUser = "is_invited_user",
+                         IsStranger = "is_stranger",
+                         Locale = "locale"}
 
 functor Make(M : AUTH) = struct
     open M
@@ -188,9 +283,16 @@ functor Make(M : AUTH) = struct
             (@fromJson j s).Value
         end
 
-    fun apiList [t ::: Type] (_ : json t) (listLabel : string) (url : string) : transaction (list t) =
+    fun apiField [t ::: Type] (_ : json t) (label : string) (url : string) : transaction t =
         page <- api url;
-        return (oneJsonField listLabel page)
+        return (oneJsonField label page)
+
+    fun apiPostField [t ::: Type] (_ : json t) (label : string) (url : string) : transaction t =
+        page <- apiPost url;
+        return (oneJsonField label page)
+
+    fun apiList [t ::: Type] (_ : json t) (listLabel : string) (url : string) : transaction (list t) =
+        apiField listLabel url
 
     val urlPrefix = "https://slack.com/"
 
@@ -200,8 +302,7 @@ functor Make(M : AUTH) = struct
         fun history ch = apiList "messages" ("conversations.history?channel=" ^ Urls.urlencode ch)
 
         fun create name =
-            s <- apiPost ("conversations.create?name=" ^ Urls.urlencode name);
-            return (oneJsonField "channel" s)
+            apiPostField "channel" ("conversations.create?name=" ^ Urls.urlencode name)
 
         fun url c = bless (urlPrefix ^ "app_redirect?channel=" ^ Urls.urlencode c.Id
                            ^ case c.SharedTeamIds of
@@ -211,8 +312,11 @@ functor Make(M : AUTH) = struct
 
     structure Chat = struct
         fun postMessage r =
-            s <- apiPost ("chat.postMessage?channel=" ^ Urls.urlencode r.Channel
-                          ^ "&text=" ^ Urls.urlencode r.Text);
-            return (oneJsonField "message" s)
+            apiPostField "message" ("chat.postMessage?channel=" ^ Urls.urlencode r.Channel
+                                    ^ "&text=" ^ Urls.urlencode r.Text)
+    end
+
+    structure Users = struct
+        fun info uid = apiField "user" ("users.info?user=" ^ Urls.urlencode uid)
     end
 end
diff --git a/src/ur/slack.urs b/src/ur/slack.urs
@@ -80,6 +80,56 @@ type message = {
      Reactions : option (list reaction)
 }
 
+type profile = {
+     Title : string,
+     Phone : string,
+     Skype : string,
+     RealName : string,
+     RealNameNormalized : string,
+     DisplayName : string,
+     DisplayNameNormalized : string,
+     StatusText : string,
+     StatusEmoji : string,
+     StatusExpiration : time,
+     AvatarHash : string,
+     FirstName : option string,
+     LastName : option string,
+     Email : option string,
+     ImageOriginal : option string,
+     Image24 : option string,
+     Image32 : option string,
+     Image48 : option string,
+     Image72 : option string,
+     Image192 : option string,
+     Image512 : option string,
+     Team : string
+}
+
+type user = {
+     Id : string,
+     TeamId : string,
+     Nam : string,
+     Deleted : bool,
+     Color : string,
+     RealName : string,
+     Tz : string,
+     TzLabel : string,
+     TzOffset : int,
+     Profile : profile,
+     IsAdmin : bool,
+     IsOwner : bool,
+     IsPrimaryOwner : bool,
+     IsRestricted : bool,
+     IsUltraRestricted : bool,
+     IsBot : bool,
+     IsStranger : option bool,
+     Updated : time,
+     IsAppUser : bool,
+     IsInvitedUser : option bool,
+     Has2fa : option bool,
+     Locale : option string
+}
+
 functor Make(M : AUTH) : sig
     structure Conversations : sig
         val list : transaction (list conversation)
@@ -92,4 +142,8 @@ functor Make(M : AUTH) : sig
         val postMessage : {Channel : string (* ID *),
                            Text : string} -> transaction message
     end
+
+    structure Users : sig
+        val info : string (* user ID *) -> transaction user
+    end
 end