Implements issue 147

heroku-config.edn

@@ -66,4 +66,9 @@
     "UCmzFaEBQlLmMTWS0IQ90tgA" "<:ist:733173880403001394>"       ; IST
   }
   :default-youtube-emoji "<:youtube:771103353454460938>"
+
+  :blacklist {
+    "(?i)refereestore\\s*\\.\\s*com" "Hi there! Just a quick head's up that I deleted your message as it contained a link to refereestore DOT com. References to that site are banned on this Discord server, as the owner of that business has a well-documented public history of serious bigotry, and we have a zero tolerance policy for such attitudes here. Please contact the admin team if you have any questions, and have a nice day! 😃"
+  }
+  :blacklist-notification-discord-channel-id "686270565828264063"  ; Admin > admin-commands
 }

pom.xml

@@ -10,7 +10,7 @@
   <modelVersion>4.0.0</modelVersion>
   <groupId>org.clojars.pmonks</groupId>
   <artifactId>futbot</artifactId>
-  <version>1.0.20201224</version>
+  <version>1.0.20210128</version>
   <name>futbot</name>
   <description>A Discord bot that delivers football (soccer) information to Discord.</description>
   <url>https://github.com/pmonks/futbot</url>

resources/config.edn

@@ -25,4 +25,7 @@
   :youtube-api-token #env YOUTUBE_API_TOKEN
   :youtube-channels {}  ; TODO: Figure out how to parse a map out of an environment variable using aero...
   :default-youtube-emoji #env DEFAULT_YOUTUBE_EMOJI
+
+  :blacklist {}  ; TODO: Figure out how to parse a map out of an environment variable using aero...
+  :blacklist-notification-discord-channel-id #env BLACKLIST_NOTIFICATION_DISCORD_CHANNEL_ID
 }

src/futbot/blacklist.clj

@@ -0,0 +1,53 @@
+;
+; Copyright © 2021 Peter Monks
+;
+; Licensed under the Apache License, Version 2.0 (the "License");
+; you may not use this file except in compliance with the License.
+; You may obtain a copy of the License at
+;
+;     http://www.apache.org/licenses/LICENSE-2.0
+;
+; Unless required by applicable law or agreed to in writing, software
+; distributed under the License is distributed on an "AS IS" BASIS,
+; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+; See the License for the specific language governing permissions and
+; limitations under the License.
+;
+; SPDX-License-Identifier: Apache-2.0
+;
+
+(ns futbot.blacklist
+  (:require [clojure.tools.logging :as log]
+            [futbot.config         :as cfg]
+            [futbot.message-util   :as mu]))
+
+(defn- check-blacklist-entry!
+  [event-data re]
+  (let [content (:content event-data)]
+    (if (re-find re content)
+      (let [message-id  (:id event-data)
+            channel-id  (:channel-id event-data)
+            author-id   (:id (:author event-data))
+            author-name (mu/nick-or-user-name event-data)
+            msg         (get cfg/blacklist re)]
+        (log/info "Deleting message" message-id "sent by" author-id (str "(" author-name ")") "in channel" channel-id "as it matched blacklist entry" (str re))
+        (mu/delete-message! cfg/discord-message-channel channel-id message-id)
+        (mu/send-dm!        cfg/discord-message-channel author-id msg)
+
+        ; Send admin message
+        (mu/create-message! cfg/discord-message-channel
+                            cfg/blacklist-notification-discord-channel-id
+                            (str "**[BLACKLIST VIOLATION]** In <#" channel-id ">, <@" author-id "> wrote:\n>>> " content))
+        true)
+      false)))
+
+(defn process!
+  [event-data]
+  (loop [f      (first cfg/blacklist-res)
+         r      (rest  cfg/blacklist-res)
+         result false]
+    (if (and f (not result))
+      (recur (first r)
+             (rest r)
+             (check-blacklist-entry! event-data f))
+      result)))

src/futbot/chat.clj

@@ -23,7 +23,8 @@
             [futbot.util           :as u]
             [futbot.message-util   :as mu]
             [futbot.config         :as cfg]
-            [futbot.source.ist     :as ist]))
+            [futbot.source.ist     :as ist]
+            [futbot.blacklist      :as blk]))
 
 (def prefix "!")
 
@@ -101,29 +102,30 @@
   (when (mu/human-message? event-data)
     (future    ; Spin off the actual processing, so we don't clog the Discord event queue
       (try
-        (let [content (s/triml (:content event-data))]
-          (if (s/starts-with? content prefix)
-            ; Parse the requested command and call it, if it exists
-            (let [command-and-args  (s/split content #"\s+" 2)
-                  command           (s/lower-case (subs (s/trim (first command-and-args)) (count prefix)))
-                  args              (second command-and-args)]
-              (if-let [public-command-fn (get public-command-dispatch-table command)]
-                (do
-                  (log/debug (str "Calling public command fn for '" command "' with args '" args "'."))
-                  (public-command-fn args event-data))
-                (when (mu/direct-message? event-data)
-                  (if-let [private-command-fn (get private-command-dispatch-table command)]
-                    (do
-                      (log/debug (str "Calling private command fn for '" command "' with args '" args "'."))
-                      (private-command-fn args event-data))
-                    (if-let [secret-command-fn (get secret-command-dispatch-table command)]
+        (if-not (blk/process! event-data)  ; First check if the given message violates the blacklist
+          (let [content (s/triml (:content event-data))]
+            (if (s/starts-with? content prefix)
+              ; Parse the requested command and call it, if it exists
+              (let [command-and-args  (s/split content #"\s+" 2)
+                    command           (s/lower-case (subs (s/trim (first command-and-args)) (count prefix)))
+                    args              (second command-and-args)]
+                (if-let [public-command-fn (get public-command-dispatch-table command)]
+                  (do
+                    (log/debug (str "Calling public command fn for '" command "' with args '" args "'."))
+                    (public-command-fn args event-data))
+                  (when (mu/direct-message? event-data)
+                    (if-let [private-command-fn (get private-command-dispatch-table command)]
                       (do
-                        (log/debug (str "Calling secret command fn for '" command "' with args '" args "'."))
-                        (secret-command-fn args event-data))
-                      (help-command! nil event-data))))))   ; If the requested private command doesn't exist, provide help
-            ; If any unrecognised message was sent to a DM channel, provide help
-            (when-not (:guild-id event-data)
-              (help-command! nil event-data))))
+                        (log/debug (str "Calling private command fn for '" command "' with args '" args "'."))
+                        (private-command-fn args event-data))
+                      (if-let [secret-command-fn (get secret-command-dispatch-table command)]
+                        (do
+                          (log/debug (str "Calling secret command fn for '" command "' with args '" args "'."))
+                          (secret-command-fn args event-data))
+                        (help-command! nil event-data))))))   ; If the requested private command doesn't exist, provide help
+              ; If any unrecognised message was sent to a DM channel, provide help
+              (when-not (:guild-id event-data)
+                (help-command! nil event-data)))))
         (catch Exception e
           (u/log-exception e))))))
 

src/futbot/config.clj

@@ -155,7 +155,17 @@
                                                                           nil)))])
                                           youtube-channels)))
 
-; Note: do NOT use mount for this, since it's used before mount has started
+(defstate blacklist
+          :start (u/mapfonk re-pattern (:blacklist config)))   ; Pre-compile all regexes as we load them from the config file
+
+(defstate blacklist-res
+          :start (keys blacklist))
+
+(defstate blacklist-notification-discord-channel-id
+          :start (:blacklist-notification-discord-channel-id config))
+
+
+; Note: do NOT use mount for these, since they're used before mount has started
 (def ^:private build-info
   (if-let [deploy-info (io/resource "deploy-info.edn")]
     (edn/read-string (slurp deploy-info))

src/futbot/message_util.clj

@@ -48,6 +48,31 @@
   (log/debug "Adding reaction" reaction "to message-id" message-id)
   (check-response-and-throw @(dm/create-reaction! discord-message-channel channel-id message-id reaction)))
 
+(defn delete-message!
+  "A version of discljord.message/delete-message! that throws errors."
+  [discord-message-channel channel-id message-id]
+  (log/debug "Deleting message-id" message-id)
+  (check-response-and-throw @(dm/delete-message! discord-message-channel channel-id message-id)))
+
+(defn create-dm!
+  "A version of discljord.message/create-dm! that throws errors."
+  [discord-message-channel user-id]
+  (log/debug "Creating DM channel with user-id" user-id)
+  (check-response-and-throw @(dm/create-dm! discord-message-channel user-id)))
+
+(defn get-channel!
+  "A version of discljord.message/get-channel! that throws errors."
+  [discord-message-channel channel-id]
+  (log/debug "Obtaining channel information for channel" channel-id)
+  (check-response-and-throw @(dm/get-channel! discord-message-channel channel-id)))
+
+(defn send-dm!
+  "Convenience method that creates a DM channel to the specified user and sends the given message to them."
+  [discord-message-channel user-id message]
+  (let [dm-channel (create-dm! discord-message-channel user-id)
+        channel-id (:id dm-channel)]
+    (create-message! discord-message-channel channel-id message)))
+
 (defn direct-message?
   "Was the given event sent via a Direct Message?"
   [event-data]
@@ -62,3 +87,10 @@
   "Was the given event generated by a human?"
   [event-data]
   (not (bot-message? event-data)))
+
+(defn nick-or-user-name
+  "Convenience method that returns the nickname, or (if there isn't one) username, of the author of the given message."
+  [event-data]
+  (if-let [name (:nick (:member event-data))]
+    name
+    (:username (:author event-data))))

src/futbot/util.clj

@@ -34,6 +34,22 @@
   [m k nf]
   (or (get m k nf) nf))
 
+(defn mapfonk
+  "Returns a new map where f has been applied to all of the keys of m."
+  [f m]
+  (when m
+    (into {}
+          (for [[k v] m]
+            [(f k) v]))))
+
+(defn mapfonv
+  "Returns a new map where f has been applied to all of the values of m."
+  [f m]
+  (when m
+    (into {}
+          (for [[k v] m]
+            [k (f v)]))))
+
 (defn clojurise-json-key
   "Converts JSON string keys (e.g. \"fullName\") to Clojure keyword keys (e.g. :full-name)."
   [k]