Start of Slack integration

urweb · Jun 25, 2020 · 096c6ba · 096c6ba
1 parent 65c78af
commit 096c6ba
Show file tree

Hide file tree

Showing 7 changed files with 221 additions and 0 deletions.
diff --git a/examples/.gitignore b/examples/.gitignore
@@ -1,5 +1,6 @@
 basic_in.ur
 *.exe
 *.sql
+slackSecrets.ur
 zoomSecrets.ur
 oidcSecrets.ur
diff --git a/examples/slackDemo.ur b/examples/slackDemo.ur
@@ -0,0 +1,11 @@
+(* For this demo, it's necessary to create slackSecrets.urs,
+ * defining [token]. *)
+structure S = Slack.Make(Slack.TwoLegged(SlackSecrets))
+
+val main =
+    chs <- S.Conversations.list;
+    return <xml><body>
+      <ul>
+        {List.mapX (fn ch => <xml><li>{[ch.Nam]}</li></xml>) chs}
+      </ul>
+    </body></xml>
diff --git a/examples/slackDemo.urp b/examples/slackDemo.urp
@@ -0,0 +1,10 @@
+library ../src/ur
+rewrite all SlackDemo/*
+database dbname=slackDemo
+sql slackDemo.sql
+safeGetDefault
+allow url https://*
+prefix http://localhost:8080/
+
+slackSecrets
+slackDemo
diff --git a/examples/slackDemo.urs b/examples/slackDemo.urs
@@ -0,0 +1 @@
+val main : transaction page
diff --git a/src/ur/lib.urp b/src/ur/lib.urp
@@ -19,5 +19,6 @@ github
 google
 hotcrp
 salesforce
+slack
 zoom
 openIdConnect
diff --git a/src/ur/slack.ur b/src/ur/slack.ur
@@ -0,0 +1,136 @@
+open Json
+
+structure Scope = struct
+    type t = Scopes.t [ChannelsHistory, ChannelsManage, ChannelsWrite, ChannelsRead]
+    val empty = Scopes.empty
+    val union = Scopes.union
+    val toString = Scopes.toString {ChannelsHistory = "channels:history",
+                                    ChannelsManage = "channels:manage",
+                                    ChannelsWrite = "channels:write",
+                                    ChannelsRead = "channels:read"}
+
+    val channelsHistory = Scopes.one [#ChannelsHistory]
+    val channelsManage = Scopes.one [#ChannelsManage]
+    val channelsRead = Scopes.one [#ChannelsRead]
+    val channelsWrite = Scopes.one [#ChannelsWrite]
+
+    val readonly = Scopes.disjoint (union channelsWrite channelsManage)
+end
+
+signature AUTH = sig
+    val token : transaction (option string)
+end
+
+functor TwoLegged(M : sig
+                      val token : string
+                  end) = struct
+    open M
+
+    val token = return (Some token)
+end
+
+val _ : json time = json_derived (addSeconds minTime) toSeconds
+
+type topic_or_purpose = {
+     Value : string,
+     Creator : string,
+     LastSet : time
+}
+val _ : json topic_or_purpose = json_record {Value = "value",
+                                             Creator = "creator",
+                                             LastSet = "last_set"}
+
+type conversation = {
+     Id : string,
+     Nam : string,
+     IsChannel : bool,
+     IsGroup : bool,
+     IsIm : bool,
+     Created : time,
+     Creator : string,
+     IsArchived : bool,
+     IsGeneral : bool,
+     Unlinked : int,
+     NameNormalized : string,
+     IsReadOnly : option bool,
+     IsShared : bool,
+     IsExtShared : bool,
+     IsOrgShared : bool,
+     PendingShared : list string,
+     IsPendingExtShared : bool,
+     IsMember : bool,
+     IsPrivate : bool,
+     IsMpim : bool,
+     LastRead : option time,
+     Topic : topic_or_purpose,
+     Purpose : topic_or_purpose,
+     PreviousNames : list string,
+     NumMembers : int,
+     Locale : option string
+}
+val _ : json conversation = json_record_withOptional
+                                {Id = "id",
+                                 Nam = "name",
+                                 IsChannel = "is_channel",
+                                 IsGroup = "is_group",
+                                 IsIm = "is_im",
+                                 Created = "created",
+                                 Creator = "creator",
+                                 IsArchived = "is_archived",
+                                 IsGeneral = "is_general",
+                                 Unlinked = "unlinked",
+                                 NameNormalized = "name_normalized",
+                                 IsShared = "is_shared",
+                                 IsExtShared = "is_ext_shared",
+                                 IsOrgShared = "is_org_shared",
+                                 PendingShared = "pending_shared",
+                                 IsPendingExtShared = "is_pending_ext_shared",
+                                 IsMember = "is_member",
+                                 IsPrivate = "is_private",
+                                 IsMpim = "is_mpim",
+                                 Topic = "topic",
+                                 Purpose = "purpose",
+                                 PreviousNames = "previous_names",
+                                 NumMembers = "num_members"}
+                                {IsReadOnly = "is_read_only",
+                                 LastRead = "last_read",
+                                 Locale = "locale"}
+
+
+functor Make(M : AUTH) = struct
+    open M
+
+    val token =
+        toko <- token;
+        case toko of
+            None => error <xml>You must be logged into Slack to use this feature.</xml>
+          | Some tok => return tok
+
+    val prefix = "https://slack.com/api/"
+
+    fun api url =
+        tok <- token;
+        WorldFfi.get (bless (prefix ^ url)) (Some ("Bearer " ^ tok)) False
+
+    fun apiOpt url =
+        tok <- token;
+        WorldFfi.getOpt (bless (prefix ^ url)) (Some ("Bearer " ^ tok)) False
+
+    fun apiPost url body =
+        tok <- token;
+        WorldFfi.post (bless (prefix ^ url)) (Some ("Bearer " ^ tok)) (Some "application/json") body
+
+    fun apiList [t ::: Type] (_ : json t) (listLabel : string) (url : string) : transaction (list t) =
+        let
+            val j : json {Records : list t} =
+                json_record {Records = listLabel}
+        in
+            page <- api url;
+            debug ("Listing: " ^ page);
+            return (@fromJson j page).Records
+        end
+
+    structure Conversations = struct
+        val list = apiList "channels" "conversations.list"
+    end
+end
diff --git a/src/ur/slack.urs b/src/ur/slack.urs
@@ -0,0 +1,61 @@
+structure Scope : sig
+    type t
+    val empty : t
+    val union : t -> t -> t
+    val readonly : t -> bool
+
+    val channelsHistory : t
+    val channelsManage : t
+    val channelsRead : t
+end
+
+signature AUTH = sig
+    val token : transaction (option string)
+end
+
+functor TwoLegged(M : sig
+                      val token : string
+                  end) : sig
+    val token : transaction (option string)
+end
+
+type topic_or_purpose = {
+     Value : string,
+     Creator : string,
+     LastSet : time
+}
+
+type conversation = {
+     Id : string,
+     Nam : string,
+     IsChannel : bool,
+     IsGroup : bool,
+     IsIm : bool,
+     Created : time,
+     Creator : string,
+     IsArchived : bool,
+     IsGeneral : bool,
+     Unlinked : int,
+     NameNormalized : string,
+     IsReadOnly : option bool,
+     IsShared : bool,
+     IsExtShared : bool,
+     IsOrgShared : bool,
+     PendingShared : list string,
+     IsPendingExtShared : bool,
+     IsMember : bool,
+     IsPrivate : bool,
+     IsMpim : bool,
+     LastRead : option time,
+     Topic : topic_or_purpose,
+     Purpose : topic_or_purpose,
+     PreviousNames : list string,
+     NumMembers : int,
+     Locale : option string
+}
+
+functor Make(M : AUTH) : sig
+    structure Conversations : sig
+        val list : transaction (list conversation)
+    end
+end
-Original file line number
+Diff line change
@@ Expand Up / @@ -19,5 +19,6 @@ github @@
     google
     hotcrp
     salesforce
+    slack
     zoom
     openIdConnect