euphonictechnologies’s diary

Haskell超初心者の日記です。OCamlが好きです。

follow us in feedly

HaskellからSlackにさくっとPOSTする

動機

Haskell用の強化学習クラスタを作っていてさくっとdebug printを確認したいことがあります。そんな時にそのマシンのローカルstdoutに吐いてもしょうがないのでslackにdebug printを吐きたいと思いました。ほったらかして学習させまくってる間スマホでいつでも確認できますし。

Slackでポスト用のURLを生成する

まずSlackのCustom Integration用のURLを生成します。

  1. チャンネルの設定からAdd an app or integrationをクリック f:id:euphonictechnologies:20160508223934p:plain

  2. App Directoryの右上のBuildを押します。 f:id:euphonictechnologies:20160508224049p:plain

  3. Make a custom integrationをクリック f:id:euphonictechnologies:20160508224119p:plain

  4. Integrationの種類としてIncoming web hooksを選びます f:id:euphonictechnologies:20160508224426p:plain

  5. Channelを選択してURLを生成します f:id:euphonictechnologies:20160508224539p:plain

これでURLが手に入りました。このURLにPOSTすれば簡単にメッセージが投稿できます。

HaskellからPOSTする

早速コードを掲載します

{-# LANGUAGE OverloadedStrings #-}

module SlackMessenger where

import Network.HTTP.Conduit
import qualified Data.ByteString.Lazy as L
import System.IO.Unsafe
import Data.ByteString.Char8
import Data.Aeson
import Control.Applicative

data Payload = Payload { test :: String } deriving Show
instance FromJSON Payload where
    parseJSON (Object v) = Payload <$> (v .: "text")

instance ToJSON Payload where
    toJSON (Payload text) = object [ "text" .= text ]

sendMessage :: String -> IO ()
sendMessage text = do
    initReq <- parseUrl "https://hooks.slack.com/services/XXXXXXXXX/XXXXXXXXX/xxxxxxxxxxxxxxxxxxxxxxxxx"
    let payload = Payload text

    let req' = initReq { secure = True, method = "POST" } -- Turn on https
    let req = (flip urlEncodedBody) req' [ ("payload", L.toStrict $ encode payload) ]

    response <- withManager $ httpLbs req

    L.putStr $ responseBody response

特別不思議なところはない感じですね。Slackは" {'payload': {'text': '投稿する内容'}} "というペイロードを必要とするのでそういう形になっています。 (flip urlEncodedBody)は別にflip必要ないですね。

http-conduitパッケージが必要です。Ubuntu上でビルドするときにlzがなくて怒られることがあるのでその場合はsudo yum install -y zlib-develが必要です。

f:id:euphonictechnologies:20160508225534p:plain

こんな感じでポストされます。

黒魔術 ... Debug.Trace.trace風に使う

unsafeSendMessageNow :: String -> a -> a
unsafeSendMessageNow text expr = unsafePerformIO $ do
    sendMessage text
    return expr

こんなことしちゃダメだゾ!