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を通じる。前者はwebsocketsとTLSをサポートする為のwuss、後者はhttp-clientとhttp-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をデッキに加えた。
処理の流れ
公式ドキュメント*2でも認めるほど、Gateway APIはやや複雑だ。まずはこのインチキダイアグラムで処理の流れを確認しよう。
矢印が示す順に、メッセージの送受信を行う。
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アクションを別のモナドのアクションから返すコンボはなかなか有用だ。
なお、forkIOはunliftioパッケージで定義され、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に対する肯定応答だ。
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モノイドを使えばよい。AltはAlternativeのインスタンスを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
watchListはdiscord-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
ボイスチャンネルに参加した時、以下の内容を投稿したい。
- 時刻
- チャンネル名
- ユーザー名
- できればアイコンも
それを実現してくれるのが埋め込みオブジェクトだ。それぞれ、timestamp、description、ユーザー名とアイコンは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クライアントのバグ)が、なかなかこぎれいにまとまっている。
無関係なメッセージを無視する処理などを加えて仕上げたのがMain.hsだ。
まとめ
特に非自明なことをやったつもりはなかったが、いくつかの発見があった。
- monad-controlのより安全*3な代替物としてのunliftioの存在。
- IOアクションを別のモナドのアクションとして返す技「モナド重ね」の有用性。
- 欲しいものを自分で実現できるDiscordのAPIの網羅性。
DiscordのBot開発は、下手なゲームよりも遊び甲斐がありそうだ。
