1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
|
open Lwt.Infix
open Disml
open Models
module Option = Base.Option
module Error = Base.Error
module List = Base.List
module Int = Base.Int
(* Client object will be stored here after creation. *)
let client, r_client = Lwt.wait ()
(* Example ping command with REST round trip time edited into the response. *)
let ping message _args =
Message.reply message "Pong!" >>= function
| Ok _message -> Lwt.return_unit
(* let diff = Time.diff (Time.now ()) (Time.of_string message.timestamp) in
Message.set_content message (Printf.sprintf "Pong! `%d ms`" (Time.Span.to_ms diff |> Float.abs |> Float.to_int)) *)
| Error e -> Error.(of_string e |> raise)
(* Send a list of consecutive integers of N size with 1 message per list item. *)
let spam message args =
let count = Option.((List.hd args >>| Int.of_string) |> value ~default:0) in
List.range 0 count
|> List.iter ~f:(fun i -> Lwt.async (fun () -> Message.reply message (string_of_int i)))
|> Lwt.return
(* Send a list of consecutive integers of N size in a single message. *)
let list message args =
let count = Option.((List.hd args >>| Int.of_string) |> value ~default:0) in
let list = List.range 0 count
|> List.sexp_of_t Int.sexp_of_t
|> Sexplib.Sexp.to_string_hum in
Message.reply message list >|= function
| Ok msg -> print_endline msg.content
| Error err -> print_endline err
(* Example of setting pretty much everything in an embed using the Embed module builders *)
let embed message _args =
let image_url = "https://cdn.discordapp.com/avatars/345316276098433025/17ccdc992814cc6e21a9e7d743a30e37.png" in
let embed = Embed.(default
|> title "Foo"
|> description "Bar"
|> url "https://gitlab.com/Mishio595/disml"
(* |> timestamp Time.(now () |> to_string_iso8601_basic ~zone:Time.Zone.utc) *)
|> colour 0xff
|> footer (fun f -> footer_text "boop" f)
|> image image_url
|> thumbnail image_url
|> author (fun a -> a
|> author_name "Adelyn"
|> author_icon image_url
|> author_url "https://gitlab.com/Mishio595/disml")
|> field ("field 3", "test", true)
|> field ("field 2", "test", true)
|> field ("field 1", "test", true)
) in
Message.reply_with ~embed message >|= ignore
(* Set the status of all shards to a given string. *)
let status message args =
let name = List.fold ~init:"" ~f:(fun a v -> a ^ " " ^ v) args in
client >>= fun client ->
Client.set_status ~name client
>>= fun _ ->
Message.reply message "Updated status" >|= ignore
(* Fetches a message by ID in the current channel, defaulting to the sent message, and prints in s-expr form. *)
let echo (message:Message.t) args =
let `Message_id id = message.id in
let id = Option.((List.hd args >>| Int.of_string) |> value ~default:id) in
Channel_id.get_message ~id message.channel_id >>= function
| Ok msg ->
let str = Message.sexp_of_t msg |> Sexplib.Sexp.to_string_hum in
Message.reply message (Printf.sprintf "```lisp\n%s```" str) >|= ignore
| _ -> Lwt.return_unit
(* Output cache counts as a a basic embed. *)
(* let cache message _args =
let module C = Cache.ChannelMap in
let module G = Cache.GuildMap in
let module U = Cache.UserMap in
let cache = Mvar.peek_exn Cache.cache in
let gc = G.cardinal cache.guilds in
let ug = G.cardinal cache.unavailable_guilds in
let tc = C.cardinal cache.text_channels in
let vc = C.cardinal cache.voice_channels in
let cs = C.cardinal cache.categories in
let gr = C.cardinal cache.groups in
let pr = C.cardinal cache.private_channels in
let uc = U.cardinal cache.users in
let pre = U.cardinal cache.presences in
let user = Option.(value ~default:"None" (map cache.user ~f:User.tag)) in
let embed = Embed.(default
|> description (Printf.sprintf
"Guilds: %d\nUnavailable Guilds: %d\n\
Text Channels: %d\nVoice Channels: %d\n\
Categories: %d\nGroups: %d\n\
Private Channels: %d\nUsers: %d\n\
Presences: %d\nCurrent User: %s"
gc ug tc vc cs gr pr uc pre user)) in
Message.reply_with ~embed message >|= ignore *)
(* Issue a shutdown to all shards, then exits the process. *)
let shutdown (message:Message.t) _args =
if message.author.id = `User_id 242675474927583232 then
client >>= Client.shutdown_all ~restart:false >|= fun _ ->
exit 0
else Lwt.return_unit
(* Request guild members to be sent over the gateway for the guild the command is run in. This will cause multiple GUILD_MEMBERS_CHUNK events. *)
let request_members (message:Message.t) _args =
client >>= fun client ->
match message.guild_id with
| Some guild -> Client.request_guild_members ~guild client >|= ignore
| None -> Lwt.return_unit
(* Creates a guild named testing or what the user provided *)
(* let new_guild message args =
let name = List.fold ~init:"" ~f:(fun a v -> a ^ " " ^ v) args in
let name = if String.length name = 0 then "Testing" else name in
Guild.create [ "name", `String name ] >>= begin function
| Ok g -> Message.reply message (Printf.sprintf "Created guild %s" g.name)
| Error e -> Message.reply message (Printf.sprintf "Failed to create guild. Error: %s" e)
end *)
(* Deletes all guilds made by the bot *)
(* let delete_guilds message _args =
let cache = Mvar.peek_exn Cache.cache in
let uid = match cache.user with
| Some u -> u.id
| None -> `User_id 0
in
let guilds = Cache.GuildMap.filter cache.guilds ~f:(fun g -> g.owner_id = uid) in
let res = ref "" in
let all = Cache.GuildMap.(map guilds ~f:(fun g -> Guild.delete g >>| function
| Ok () -> res := Printf.sprintf "%s\nDeleted %s" !res g.name
| Error _ -> ()) |> to_alist) |> List.map ~f:(snd) in
Deferred.all all >>= (fun _ ->
Message.reply message !res) >|= ignore *)
(* let role_test (message:Message.t) args =
let exception Member_not_found in
let cache = Mvar.peek_exn Cache.cache in
let name = List.fold ~init:"" ~f:(fun a v -> a ^ " " ^ v) args in
let create_role name guild_id =
Guild_id.create_role ~name guild_id >>| function
| Ok role -> role
| Error e -> Error.raise e
in
let delete_role role =
Role.delete role >>| function
| Ok () -> ()
| Error e -> Error.raise e
in
let add_role member role =
Member.add_role ~role member >>| function
| Ok () -> role
| Error e -> Error.raise e
in
let remove_role member role =
Member.remove_role ~role member >>| function
| Ok () -> role
| Error e -> Error.raise e
in
let get_member id = match Cache.GuildMap.find cache.guilds id with
| Some guild ->
begin match List.find guild.members ~f:(fun m -> m.user.id = message.author.id) with
| Some member -> member
| None -> raise Member_not_found
end
| None -> raise Member_not_found
in
match message.guild_id with
| Some id -> begin try
let member = get_member id in
create_role name id
>>= add_role member
>>= remove_role member
>>= delete_role
>>= (fun () -> Message.reply message "Role test finished")
with
| Member_not_found -> Message.reply message "Error: Member not found"
| exn -> Message.reply message (Printf.sprintf "Error: %s" Error.(of_exn exn |> to_string_hum))
end >|= ignore
| None -> () *)
(* let check_permissions (message:Message.t) _args =
let cache = Mvar.peek_exn Cache.cache in
let empty = Permissions.empty in
let permissions = match message.guild_id, message.member with
| Some g, Some m ->
begin match Cache.guild cache g with
| Some g ->
List.fold m.roles ~init:Permissions.empty ~f:(fun acc rid ->
let role = List.find_exn g.roles ~f:(fun r -> r.id = rid) in
Permissions.union acc role.permissions)
| None -> empty
end
| _ -> empty in
let allow, deny = match message.member with
| Some m ->
begin match Cache.text_channel message.channel_id cache with
| Some c ->
List.fold c.permission_overwrites ~init:(empty, empty) ~f:(fun (a,d) {allow; deny; id; kind} ->
let `User_id uid = message.author.id in
if (kind = "role" && List.mem m.roles (`Role_id id) ~equal:(=)) || (kind = "user" && id = uid) then
Permissions.union allow a, Permissions.union deny d
else a, d
)
| None -> empty, empty
end
| None -> empty, empty in
let g_perms = Permissions.elements permissions
|> List.sexp_of_t Permissions.sexp_of_elt
|> Sexplib.Sexp.to_string_hum in
let c_perms = Permissions.(union permissions allow
|> diff deny
|> elements)
|> List.sexp_of_t Permissions.sexp_of_elt
|> Sexplib.Sexp.to_string_hum in
Message.reply message (Printf.sprintf "Global Permissions: %s\nChannel Permissions: %s" g_perms c_perms) >|= ignore *)
|