diff options
| -rw-r--r-- | fig-monitor-discord/src/Fig/Monitor/Discord.hs | 77 | ||||
| -rw-r--r-- | fig-monitor-discord/src/Fig/Monitor/Discord/Utils.hs | 4 |
2 files changed, 61 insertions, 20 deletions
diff --git a/fig-monitor-discord/src/Fig/Monitor/Discord.hs b/fig-monitor-discord/src/Fig/Monitor/Discord.hs index b238253..99c359d 100644 --- a/fig-monitor-discord/src/Fig/Monitor/Discord.hs +++ b/fig-monitor-discord/src/Fig/Monitor/Discord.hs @@ -10,6 +10,7 @@ import qualified Control.Concurrent.Async as Async import qualified Control.Concurrent.Chan as Chan import qualified Control.Concurrent.MVar as MVar +import qualified Data.Maybe as Maybe import qualified Data.Text as Text import qualified Data.ByteString.Base64 as BS.Base64 import qualified Data.Map.Strict as Map @@ -26,9 +27,19 @@ import Fig.Bus.Client import Fig.Monitor.Discord.Utils data OutgoingMessage = OutgoingMessage - { chan :: Integer - , user :: Text - , msg :: Text + { chan :: !Integer + , user :: !Text + , msg :: !Text + } + +data EmojiInfo = EmojiInfo + { id :: !Dis.EmojiId + , animated :: !Bool + } deriving Show + +data BotInfo = BotInfo + { userId :: !Dis.UserId + , emotes :: !(Map.Map Text EmojiInfo) } stickerUrl :: Text -> Dis.StickerFormatType -> Text @@ -44,7 +55,7 @@ stickerUrl sid ty = base <> sid <> "." <> ext discordBot :: Config -> (Text, Text) -> IO () discordBot cfg busAddr = do outgoing <- Chan.newChan @OutgoingMessage - ourId <- MVar.newEmptyMVar + botInfo <- MVar.newEmptyMVar busClient busAddr (\cmds -> do cmds.subscribe [sexp|(monitor discord chat outgoing)|] @@ -59,9 +70,22 @@ discordBot cfg busAddr = do , updateStatusOptsAFK = False } Dis.sendCommand (Dis.UpdateStatus opts) - Dis.restCall Dis.GetCurrentUser >>= \case - Left e -> log $ "failed to retrieve discord user: " <> tshow e - Right u -> liftIO . MVar.putMVar ourId $ Dis.userId u + userId <- Dis.restCall Dis.GetCurrentUser >>= \case + Left e -> throwM . FigMonitorDiscordException $ "Failed to retrieve discord user: " <> tshow e + Right u -> pure $ Dis.userId u + let gid = Dis.DiscordId $ Dis.Snowflake $ fromIntegral cfg.guildId + emotes <- Dis.restCall (Dis.ListGuildEmojis gid) >>= \case + Left e -> throwM . FigMonitorDiscordException $ "Failed to retrieve server emoji: " <> tshow e + Right emotes -> pure . Map.fromList + $ Maybe.mapMaybe + (\e -> do + eid <- Dis.emojiId e + animated <- Dis.emojiAnimated e + pure (Dis.emojiName e, EmojiInfo { id = eid, animated }) + ) + emotes + log $ tshow emotes + liftIO . MVar.putMVar botInfo $ BotInfo{..} log "Initialized Discord bot" dst <- ask liftIO . void . Async.async . forever $ flip runReaderT dst do @@ -83,7 +107,7 @@ discordBot cfg busAddr = do Dis.InteractionCreate cmd@Dis.InteractionApplicationCommand{} -> do void . Dis.restCall . Dis.CreateInteractionResponse (Dis.interactionId cmd) (Dis.interactionToken cmd) $ Dis.interactionResponseBasic "pong" Dis.MessageCreate m -> do - botId <- liftIO $ MVar.readMVar ourId + binfo <- liftIO $ MVar.readMVar botInfo let chan = Dis.messageChannelId m auth = Dis.messageAuthor m @@ -103,9 +127,10 @@ discordBot cfg busAddr = do replyStr = replyUser >>= \ru -> if ru == "The Computer" then replyMsg >>= ( - PCRE.scan [PCRE.re|^`\<(.*)\>`|] >>> \case - ((_, [compName]):_) -> Just compName - _ -> Just ru + PCRE.scan [PCRE.re|^`\<(.*)\>`|] + >>> \case + ((_, [compName]):_) -> Just compName + _ -> Just ru ) else Just ru msgReplacedEmotes = PCRE.gsub @@ -128,7 +153,7 @@ discordBot cfg busAddr = do ) <> " (" <> stickerUrl (tshow . Dis.unId $ Dis.stickerItemId sticker) (Dis.stickerItemFormatType sticker) <> ")" _ -> msgReplacedEmotes -- in unless (Dis.userIsBot auth) do - unless (Dis.userId auth == botId) do + unless (Dis.userId auth == binfo.userId) do log $ "Received: " <> processedMsg <> " (from " <> name <> ")" liftIO $ cmds.publish [sexp|(monitor discord chat incoming)|] [ SExprInteger . fromIntegral . Dis.unSnowflake $ Dis.unId chan @@ -152,13 +177,27 @@ discordBot cfg busAddr = do , Right user <- decodeUtf8 <$> BS.Base64.decodeBase64 (encodeUtf8 euser) , Right msg <- decodeUtf8 <$> BS.Base64.decodeBase64 (encodeUtf8 emsg) -> do log $ "Sending: " <> msg <> " (from " <> user <> ")" - let replacements :: [(Text, Text)] = - [ (":mrgreen:", "<:mrgreen:1093634800792911972>") - , (":mrblue:", "<:mrblue:1154526193358491719>") - , (":mrred:", "<:mrred:1154524307649724449>") - ] - let newMsg = foldr' (\(n, r) h -> Text.replace n r h) msg replacements - Chan.writeChan outgoing OutgoingMessage { chan, user, msg = newMsg } + binfo <- liftIO $ MVar.readMVar botInfo + let + replacements :: [(Text, Text)] = + [ ("🟢", ":mrgreen:") + , ("🔵", ":mrblue:") + , ("🔴", ":mrred:") + , ("🟡", ":mryellow:") + ] + newMsg = foldr' (\(n, r) h -> Text.replace n r h) msg replacements + msgReplacedEmotes = PCRE.gsub + [PCRE.re|:([\w_-]+):|] + (\(_ :: Text) -> \case + ([emotename] :: [Text]) -> case Map.lookup emotename binfo.emotes of + Just einfo -> + "<" <> (if einfo.animated then "a" else "") + <> ":" <> emotename <> ":" <> tshow einfo.id <> ">" + _ -> ":" <> emotename <> ":" + _ -> "<unknown emote>" + ) + newMsg + Chan.writeChan outgoing OutgoingMessage { chan, user, msg = msgReplacedEmotes } _ -> log $ "Invalid outgoing message: " <> tshow d ) (pure ()) diff --git a/fig-monitor-discord/src/Fig/Monitor/Discord/Utils.hs b/fig-monitor-discord/src/Fig/Monitor/Discord/Utils.hs index 21e3a72..bf9e661 100644 --- a/fig-monitor-discord/src/Fig/Monitor/Discord/Utils.hs +++ b/fig-monitor-discord/src/Fig/Monitor/Discord/Utils.hs @@ -15,12 +15,14 @@ newtype FigMonitorDiscordException = FigMonitorDiscordException Text instance Exception FigMonitorDiscordException data Config = Config - { authToken :: Text + { authToken :: !Text + , guildId :: !Integer } deriving (Show, Eq, Ord) configCodec :: Toml.TomlCodec Config configCodec = do authToken <- Toml.text "auth_token" Toml..= (\a -> a.authToken) + guildId <- Toml.integer "guild_id" Toml..= (\a -> a.guildId) pure $ Config{..} loadConfig :: FilePath -> IO Config |