HaskellでDiscordのBotを作る

Discordはゲーミング向けのテキストチャットと音声通話を兼ねるプラットフォームであり、「テキストチャンネル」と「ボイスチャンネル」の二種を好きなだけ作ることができる。もちろん音声を全チャンネルに常時垂れ流すわけには行かないので、通話するにはボイスチャンネルに参加するという手順を踏む必要がある。しかし、例えば誰かがやっているゲームに混ざろうとしてボイスチャンネルに参加しても、チャンネル外のユーザーにはいかなる通知も発生しないため、気づかれないままのことがよくある。

そこで、ボイスチャンネルに参加したとき、テキストチャンネルにその旨を投稿するボットを用意すれば、気軽に通話の合図を送れる。全員に通話の意思を表明でき、Skypeの着信のように邪魔にもならないので、少人数のグループにとって極めて有用である。

Discordは柔軟なAPIを用意しているため、比較的容易にそのようなボットを開発できる。もちろん、Haskellを使って実装する。この記事で使用するソースコードGitHub - fumieval/discord-vc-notificationにある。

使ってみる (2018/02/28追記)

アプリは公開してある。このURLから認証し、テキストチャンネルのトピックにdiscord-vc-notification: Generalという行を追加すれば、お使いのサーバーのGeneralボイスチャンネルに誰か参加したときに通知される。

https://discordapp.com/oauth2/authorize?client_id=418329413860458496&scope=bot&permissions=53484608

APIの利用

まず、からNew Appをクリックし、アプリおよびボットの情報を登録する。フォームを適当に埋めるだけで良い。完了したらClient IDとBot tokenをメモしておく。そして、以下のURLを開き、どのサーバーに追加するか決めて認証する。なお、53484608はパーミッションエンコードした整数で、公式のツールで計算することができる。

https://discordapp.com/oauth2/authorize?client_id=クライアントID&scope=bot&permissions=53484608

デッキ構築

Discordは、WebSocketでリアルタイムに通信するGatewayとRESTful APIの二種類を提供し、どちらもTLSを通じる。前者はwebsocketsTLSをサポートする為のwuss、後者はhttp-clienthttp-client-tlsを必要とする。stackでパッケージを作成し、package.yamlに以下の依存ライブラリを指定する。

dependencies:
- base >= 4.7 && < 5
- aeson
- bytestring
- http-client
- http-client-tls
- http-types
- text
- time
- unordered-containers
- websockets
- wuss
- rio
- unliftio

Preludeのゾロ新*1には懐疑的だが、あえてMichael Snoymanがつい最近リリースしたrioをデッキに加えた。

github.com

処理の流れ

公式ドキュメント*2でも認めるほど、Gateway APIはやや複雑だ。まずはこのインチキダイアグラムで処理の流れを確認しよう。f:id:fumiexcel:20180208223954p:plain

矢印が示す順に、メッセージの送受信を行う。

Hello

まずはGatewayに接続してみよう(dvn-connect.hs)。

import Control.Monad
import qualified Data.ByteString.Char8 as B
import qualified Network.WebSockets as WS
import qualified Wuss as WS

main = WS.runSecureClient "gateway.discord.gg" 443 "/?v=6&encoding=json"
  $ \wsConn -> forever $ WS.receiveData wsConn >>= B.putStrLn

実行すると、図に示したように、まずコード10のHelloメッセージが送られてくるのが確認できる。opがコード、dが内容を表す。heartbeat_intervalは、こちらがHeartbeatメッセージを送信すべき周期をミリ秒単位で指定している。

{"t":null,"s":null,"op":10,"d":{"heartbeat_interval":41250,"_trace":["gateway-prd-main-qrq5"]}}

Heartbeat

次にHeartbeatを送信する(dvn-heartbeat.hs)。これを怠ると一定時間後に切断されてしまう。

WebSocketの接続はプログラム全体で共有したいが、そんな時にrioが役に立つ。最大の売りであるRIO型は、ReaderT r IOと等価なモナドなのだ。 rioはロガーも提供しており、Env型に放り込むことでRIO内なら好きな時にログを出力できる。

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
import RIO
import UnliftIO.Concurrent
import Data.Aeson
import Data.Aeson.Types
import qualified Network.WebSockets as WS
import qualified Wuss as WS

data Env = Env
  { wsConn :: WS.Connection
  , logFunc :: LogFunc
  }

instance HasLogFunc Env where
  logFuncL = to logFunc

send :: Value -> RIO Env ()
send v = ask >>= \Env{..} -> liftIO $ WS.sendTextData wsConn $ encode v

JSONの解釈にはaesonのParserモナドを使う。固有アクションの一つである(.:) :: FromJSON a => Object -> Text -> Parser aは、オブジェクトから指定された名前のフィールドを取り出す。

そして、実行すべきアクションを結果として返す。IOアクションを別のモナドのアクションから返すコンボはなかなか有用だ。 なお、forkIOunliftioパッケージで定義され、import UnliftIO.Concurrentからインポートしたものを参照している。RIOに対応しているため、自分でReaderTを剥がす必要がなく、ボンタンアメのごとくそのまま使える。rioを使った甲斐があったと言えるだろう。

sendHeartbeat :: Int -> RIO Env ()
sendHeartbeat period = forever $ do
  send $ object ["op" .= (1 :: Int), "d" .= (251 :: Int)]
  liftIO $ threadDelay $ 1000 * period

hello :: Object -> Parser (RIO Env ())
hello obj = do
  op <- obj .: "op"
  guard $ op == (10 :: Int)
  dat <- obj .: "d"
  interval <- dat .: "heartbeat_interval"
  return $ void $ forkIO $ sendHeartbeat interval

mainは以下のようになる。

main :: IO ()
main = WS.runSecureClient "gateway.discord.gg" 443 "/?v=6&encoding=json"
  $ \wsConn -> do
    logOpts <- mkLogOptions stderr True -- verbose
    withStickyLogger logOpts $ \logFunc -> forever $ do
      bs <- WS.receiveData wsConn
      obj <- case decode bs of
        Nothing -> fail "Failed to parse a JSON object"
        Just a -> pure a
      runRIO Env{..} $ case parse hello obj of
        Success m -> m
        Error _ -> logWarn $ "Unhandled: " <> displayBytesUtf8 (toStrictBytes bs)

実行するといい感じにフォーマットされたログが出てくる。なお"op":11は、 Heartbeatに対する肯定応答だ。

f:id:fumiexcel:20180211161028p:plain

Identify

次は認証のためのデータを送信する( dvn-identify.hs) 。ここでトークンが必要になるので、環境変数から取得してEnvにセットする。

+import System.Environment

 data Env = Env
   { wsConn :: WS.Connection
+  , botToken :: Text
   , logFunc :: LogFunc
 main = WS.runSecureClient "gateway.discord.gg" 443 "/?v=6&encoding=json"
   $ \wsConn -> do
+    botToken <- fromString <$> getEnv "DISCORD_BOT_TOKEN"
     logOpts <- mkLogOptions stderr True

あとは固定されたデータを送るだけでかまわない。

identify :: RIO Env ()
identify = do
  Env{..} <- ask
  send $ object
    [ "op" .= (2 :: Int)
    , "d" .= object
      [ "token" .= botToken
      , "properties" .= object
        [ "$os" .= T.pack "linux"
        , "$browser" .= T.pack "discord-vc-notification"
        , "$device" .= T.pack "discord-vc-notification"
        ]
      , "compress" .= False
      , "large_threshold" .= (250 :: Int)
      , "shard" .= [0 :: Int, 1]
      , "presence" .= object
        [ "game" .= Null
        , "status" .= T.pack "online"
        , "since" .= Null
        , "afk" .= False
        ]
      ]
    ]

helloを受け取った直後に送信するようにすれば完成だ。

   interval <- dat .: "heartbeat_interval"
-  return $ void $ forkIO $ sendHeartbeat interval
+  return $ do
+    _ <- forkIO $ sendHeartbeat interval
+    identify

実行すると以下のような出力が得られるはずだ。READYは認証に成功したことを意味し、このボットを承認しているサーバーの数だけGUILD_CREATEが送られてくる。

2018-02-11 16:22:46.592659: [warn] Unhandled: {"t":null,"s":null,"op":11,"d":null}
@(tutorial/dvn-identify.hs:75:20)
2018-02-11 16:22:46.593743: [warn] Unhandled: {"t":"READY","s":1,"op":0,"d":{"v":6,"user_settings":{},"user":{"verified":true,"username":"Wight","mfa_enabled":false,"id":"410395043501965312","email":null,"discriminator":"4943","bot":true,"avatar":"d4b67c58bf382981f5fb8ce73930cf4c"},"shard":[0,1],"session_id":"82c05e747cd8480db30909572a9a493e","relationships":[],"private_channels":[],"presences":[],"guilds":[{"unavailable":true,"id":"349143256711561216"},{"unavailable":true,"id":"410796870978502657"}],"_trace":["gateway-prd-main-1476","discord-sessions-prd-1-19"]}}
@(tutorial/dvn-identify.hs:75:20)
2018-02-11 16:22:46.594370: [warn] Unhandled: {"t":"GUILD_CREATE", ...

Guild Create

いよいよ本質的な機能の実装に迫る。どのボイスチャンネルを監視し、どのテキストチャンネルに投稿するのかを、チャンネルに設定されたトピックを読み込んで決める(dvn-watchlist.hs)。

現在は受信処理をするのはhelloしかないが、Object -> Parser (RIO Env ())を合成可能にすれば新しいハンドラを定義できる。答えは簡単で、Altモノイドを使えばよい。AltAlternativeインスタンスMonoidに変換するラッパーで、Parserが失敗した時に次のハンドラを呼び出すことができる。これからよく使うので、型シノニムを定義しておこう。

+import Data.Monoid
-hello :: Object -> Parser (RIO Env ())
-hello obj = do
+type MessageHandler = Object -> Alt Parser (RIO Env ())
+
+combined :: MessageHandler
+combined = mconcat [hello] 
+
+hello :: MessageHandler
+hello obj = Alt $ do
-      runRIO Env{..} $ case parse hello obj of
+      runRIO Env{..} $ case parse (getAlt . combined) obj of

サーバー内のチャンネル一覧を含む巨大なオブジェクト(guildオブジェクト)がGUILD CREATEメッセージとして飛んでくる。これを処理する関数guildCreateと、チャンネルのトピックを読み込み、監視すべきボイスチャンネルの一覧を取得するwatchListを定義する。取得した情報はHashMapのIORefとして管理する。

+import qualified Data.HashMap.Strict as HM
+import qualified Data.Text as T
   , logFunc :: LogFunc
+  , watchMap :: IORef (HM.HashMap Text Text)
   }
     logOpts <- mkLogOptions stderr True
+    watchMap <- newIORef HM.empty
     withStickyLogger logOpts $ \logFunc -> forever $ do

watchListdiscord-vc-notification:で始まる行をトピックから探し、IDの一覧を取り出す。ボイスチャンネルについてはそもそもtopicフィールドが存在しないので、空のリストを返す。

watchList :: Object -> Parser [(Text, Text)]
watchList obj = do
  topic <- obj .: "topic"
  tcid <- obj .: "id"
  return $ do
    str <- T.lines topic
    vcids <- maybeToList $ T.stripPrefix "discord-vc-notification:" str
    vcid <- T.splitOn " " vcids
    guard $ not $ T.null vcid
    return (vcid, tcid)
  <|> pure []

各チャンネルについてwatchListを呼び出し、HashMapに変換したのちIORefに書き込む。

guildCreate :: MessageHandler
guildCreate obj = Alt $ do
  t <- obj .: "t"
  guard $ t == ("GUILD_CREATE" :: Text)
  dat <- obj .: "d"
  chs <- dat .: "channels"
  wm <- HM.fromList . concat <$> traverse watchList (chs :: [Object])
  return $ do
    Env{..} <- ask
    writeIORef watchMap wm
    logDebug $ "watchlist: " <> displayShow wm

忘れずに定義した関数をcombinedに追加しよう。

 combined :: MessageHandler
 combined = mconcat
   [ hello
+  , guildCreate
   ]

Discordのチャンネルのトピックに、discord-vc-notification: 41xxxxxxxxxxxxxx(チャンネルID)という行を追加してみよう。チャンネルIDはDiscordのクライアントからUser Settings -> Appearance -> Developer Modeを有効にし、チャンネル名を右クリックすることで取得できる。成功すれば、起動時に以下のようなログが出るはずだ。

2018-02-11 17:06:35.557899: [debug] watchlist: fromList [("349143256711561218","410323579796717579")]
@(tutorial/dvn-watchlist.hs:79:5)

Voice State Update

ユーザーが参加、退出、ミュートなどの操作をしたとき、VOICE_STATE_UPDATEメッセージが送られてくる。内容はVoice Stateオブジェクトで、ここからユーザーIDとチャンネルIDを取り出す。

ユーザーが参加した時だけその旨を投稿したいので、退出やミュートに関するイベントは無視する必要がある。そのため、各ユーザーはどのボイスチャンネルに入っているかをHashMapで管理する。

   , watchMap :: IORef (HM.HashMap Text Text)
+  , memberState :: IORef (HM.HashMap Text Text)
   }
     watchMap <- newIORef HM.empty
+    memberState <- newIORef HM.empty
     withStickyLogger logOpts $ \logFunc -> forever $ do

この場合アトミック性は要求されないが、atomicModifyIORefの結果としてアクションを返す小技を紹介しておこう。

voiceChannelJoin :: MessageHandler
voiceChannelJoin obj = Alt $ do
  t <- obj .: "t"
  guard $ t == ("VOICE_STATE_UPDATE" :: Text)
  dat <- obj .: "d"
  cid <- dat .:? "channel_id"
  uid <- dat .: "user_id"
  return $ do
    Env{..} <- ask
    wm <- readIORef watchMap
    joined <- atomicModifyIORef memberState
      $ \ms -> (HM.alter (const cid) uid ms, do
        vc <- cid
        tc <- HM.lookup vc wm
        return $ postJoined uid vc tc)
    sequence_ joined

postJoined :: Text -> Text -> Text -> RIO Env ()
postJoined uid vc tc = logInfo
  $ mconcat [display tc, ": ", display uid, " joined ", display vc]
 combined :: MessageHandler
 combined = mconcat
   [ hello
   , guildCreate
+  , voiceChannelJoin
   ]

combinedに新しいハンドラを追加して出来上がり( dvn-update.hs )。実際にDiscord側のボイスチャンネルに参加してみると、以下のようなログが残る。体裁を整えてメッセージとして投稿すればいよいよ完成だ。

2018-02-11 17:23:44.765171: [info] 410796870978502659: 345439212583256064 joined 410796870978502661

POST /channels/:channel_id/messages

dvn-post.hs からはいよいよRESTful APIの出番が出てくる。異なるプロトコルなのでやや面倒ではあるが、特別難しいことはない。

+import qualified Data.Text.Encoding as T
+import Data.Time
+import qualified Network.HTTP.Client as HC
+import Network.HTTP.Client.TLS
+import Network.HTTP.Types

HTTPクライアントのマネージャーを用意しておく。プログラム全体で扱う値をEnv型にまとめておいたおかげで、このような変更がしやすい。

   { wsConn :: WS.Connection
+  , hcManager :: HC.Manager
   , botToken :: Text
     memberState <- newIORef HM.empty
+    hcManager <- HC.newManager tlsManagerSettings
     withStickyLogger logOpts $ \logFunc -> forever $ do

APIを呼び出す関数は以下のように定義できる。

discordApi :: Method -> [Text] -> Maybe Value -> RIO Env Object
discordApi m ps obj = ask >>= \Env{..} -> do
  initialRequest <- liftIO $ HC.parseRequest "https://discordapp.com/"
  resp <- liftIO $ HC.httpLbs initialRequest
    { HC.method = m
    , HC.path = T.encodeUtf8 $ T.intercalate "/" $ "/api" : ps
    , HC.requestBody = maybe mempty (HC.RequestBodyLBS . encode) obj
    , HC.requestHeaders =
      [ ("Authorization", "Bot " <> T.encodeUtf8 botToken)
      , ("User-Agent", "discord-vc-notification")
      , ("Content-Type", "application/json")
      ]
    }
    hcManager
  case decode $ HC.responseBody resp of
    Nothing -> fail $ "Malformed response: " ++ show (HC.responseBody resp)
    Just a -> return a

ボイスチャンネルに参加した時、以下の内容を投稿したい。

  • 時刻
  • チャンネル名
  • ユーザー名
  • できればアイコンも

それを実現してくれるのが埋め込みオブジェクトだ。それぞれ、timestampdescription、ユーザー名とアイコンはauthorに含めることでいい感じに投稿できる。GET /users/:user_idを呼び出すとユーザーの名前とアイコンのURLのための識別番号を取得できる。実際に投稿できるようにpostJoinedを書き換える。

postJoined :: Text -- user id
  -> Text -- voice channel id
  -> Text -- text channel id
  -> RIO Env ()
postJoined uid vc tc = do
  now <- liftIO getCurrentTime
  uInfo <- discordApi "GET" ["users", uid] Nothing
  author <- either fail pure $ flip parseEither uInfo $ const $ do
    name <- uInfo .: "username"
    avatar <- uInfo .: "avatar"
    return $ object
      [ "name" .= (name :: Text)
      , "icon_url" .= T.intercalate "/"
        ["https://cdn.discordapp.com", "avatars", uid, avatar <> ".png?size=256"]
      ]
  void $ discordApi "POST" ["channels", tc, "messages"]
    $ Just $ object
      [ "content" .= T.empty
      , "embed" .= object
        [ "description" .= T.concat ["Joined <#", vc, ">"]
        , "timestamp" .= formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%S" now
        , "author" .= author
        ]
      ]

そして、ボイスチャンネルに参加すると、このようなメッセージが投稿される。あたかもテキストチャンネルに参加したかのように表示されている(おそらくDiscordクライアントのバグ)が、なかなかこぎれいにまとまっている。

f:id:fumiexcel:20180211182202p:plain

無関係なメッセージを無視する処理などを加えて仕上げたのがMain.hsだ。

まとめ

特に非自明なことをやったつもりはなかったが、いくつかの発見があった。

  • monad-controlのより安全*3な代替物としてのunliftioの存在。
  • IOアクションを別のモナドのアクションとして返す技「モナド重ね」の有用性。
  • 欲しいものを自分で実現できるDiscordのAPIの網羅性。

DiscordのBot開発は、下手なゲームよりも遊び甲斐がありそうだ。

*1:ジェネリック医薬品を指す俗語

*2:"The API for interacting with Gateways is complex and fairly unforgiving"

*3:monad-control is trickyを参照