slack-api + bloodhound + servant でbot+αを作る

by Daishi Nakajima

Haskell (その2) Advent Calendar 2017 (7日目)の記事です。

  • Advent Calendarのネタ探しに何か作ろうと思った。
  • slack上のQA形式の知見を手動でまとめていき、後から参照しやすくするbotを作りたいと思った。
  • (リリースまで行けなかった。次の休みには公開してリンク貼ります。。無念　)　=> 追記2017-12-29: 作ったやつ => https://slacknowledge.pig-brewing.com/

特にすごいことはなく普通にサービスを作ってしまったので、使ったライブラリとその使い方などを紹介したいと思います。

主なやったことは次の３点:

slack botを作る

Slack RTM APIのbinding。

入れる

stackageにはないのでcommit指定。masterを使ったほうが良い。

stack.yaml 

- location:
    git: https://github.com/mpickering/slack-api.git
    commit: 1240e45490925fe0211a81c553a38d39c47058cd

botの動かし方

  • repositoryのexampleがわかりやすい
  • getNextEventし続ける関数を作り、それをwithSlackHandleで実行する
  • getNextEventが返すEventに対してパターンマッチしてやりたいことをやる
knowledgeBot :: SlackHandle -> IO ()  
knowledgeBot h = forever $ do  
  getNextEvent h >>= \case
    (ReactionAdded _ "memo" _ (EmbeddedMessageItem cid msg_ts) _) -> -- reactionが追加された時の処理

-- withSlackHandle conf knowledgeBot

bot以外のAPIを叩く

slack-apiを使って他のapiも叩いてみる

  • slackのAppの設定から各種permissionを設定
  • confにはOAuth Access Token(botではない)を使う

例えばusers.infoの取得

data UserInfo = UserInfo  
  { _userInfoUser :: User -- Userはslack-apiに定義されている
  } deriving (Generic, Show)
instance FromJSON UserInfo where  
  parseJSON = genericParseJSON $ defaultOptions {fieldLabelModifier = toSnake . drop 9}

getUser  
    :: (MonadError T.Text m, MonadIO m)
    => SlackConfig
    -> UserId
    -> m UserInfo
getUser conf (Id uid) = do  
  res <- makeSlackCall conf "users.info" $
    (W.param "user"     .~ [uid])
  fromJSON' res

fromJSON' :: (FromJSON a, MonadError T.Text m) => Value -> m a  
fromJSON' x = case fromJSON x of  
    Error e -> throwError (T.pack e)
    Success r -> return r

Elasticsearchに保存・検索

  • bloodhoundを使用

  • Elasticsearchのclientライブラリ。5系にも対応している

  • こちらもrepositoryのexampleがわかりやすい。
  • 後はちゃんと型を見て使う

indexの設定

  • 各種設定値
runBH' = withBH defaultManagerSettings server

migration :: IO()  
migration = runBH' $ do  
  _ <- createIndex indexSettings index
  True <- indexExists index
  rs <-  putMapping index threadMapping ThreadMapping
  liftIO $ print rs

server = (Server "http://localhost:9200")  
index = IndexName "hogehoge"  
indexSettings = IndexSettings (ShardCount 1) (ReplicaCount 0)  
threadMapping = MappingName "thread"

data ThreadMapping = ThreadMapping deriving (Eq, Show)

instance ToJSON ThreadMapping where  
  toJSON _ =
    [aesonQQ|
{
  "properties": {
    "ts": {
      "type": "double"
    },
    "tags": {
      "type": "string",
      "index": "not_analyzed"
    }
  }
}
|]
  • mapping設定にData.Aeson.QQが便利

Documentをindex

  • jsonにできるものと、　DocIdを渡す
indexThread :: Thread -> IO ()  
indexThread thread = runBH' $ do  
  res <- indexDocument index threadMapping defaultIndexDocumentSettings
    thread (DocId  (formatSlackTimeStamp $ thread ^. ts))
  liftIO $ print res

例えば次のような型を扱っている。

data Thread = Thread  
  { _threadTs   :: SlackTimeStamp
  , _threadTags :: [Text]
  } deriving (Generic, Show)

ToJSONとFromJSONにする必要がある。

検索

  • Searchを組み立ててsearchByIndexを使う
  • 結果はByteStringだがbloodhoundのSearchResultにdecodeできる
searchThread :: (MonadError String m, MonadIO m) => Maybe Text -> m [Thread]  
searchThread mtag = do  
  let mquery =　fmap (\tag -> TermQuery (Term "tags" tag) Nothing) mtag
  res <- liftIO . runBH' $ do
    let search = Search
          { queryBody = mquery
          , filterBody = Nothing
          , sortBody = Just [DefaultSortSpec (mkSort (FieldName "ts") Descending)]
          , aggBody = Nothing
          , highlight = Nothing
          , trackSortScores = False
          , from = From 0
          , size = Size 20
          , searchType = SearchTypeQueryThenFetch
          , fields = Nothing
          , source = Nothing
          }
    searchByIndex index search
  case eitherDecode (responseBody res) of
    Right res -> return $ catMaybes $ hitSource <__aSyNcId_<__gpFXnAz__gt; (hits . searchHits $ res)
    Left e -> throwError e
  • ここでは雑にsourceだけを取り出している

web site作る

servantでWebページ作る

  • htmlをレスポンスするにはText.Blaze.Markupを使う
  • template engineにはheterocephalusを使用
type API = Get '[HTML] Markup  
  :<|> "search" :> QueryParam "tag" Text :> Get '[HTML] Markup

api :: Proxy API  
api = Proxy

server :: Server API  
server = (searchR Nothing)  
         :<|> searchR

searchR :: Maybe Text -> Handler Markup  
searchR mtag = do  
  ethreads <- liftIO $ runExceptT $ ES.searchThread mtag
  return $ case ethreads of
    Right threads -> $(compileTextFile "templates/index.html")
    Left e ->  $(compileTextFile "templates/500.html")

ghciを使ってhot reloadしながら素早く開発する　（おまけ）

細かくpreviewしながら作る必要がある物だとビルドに時間がかかってはたまらない。

haskellにはghci(インタプリタ)があるのでそういうときも困らない。

関数を実行して試すだけなら、ghciでmoduleをloadして関数を呼ぶだけ。

下記はapi,botのようにプロセス起動しっぱなしにしときつつreloadしたい時の話。

rapidというpackageを使用した。

module Main where

import Rapid  
import qualified Slacknowledge.Api as Api  
import qualified Slacknowledge.Bot as Bot

main = return ()

up :: IO ()  
up = rapid 0 $ \r -> do  
  restart r "api" Api.startApp
  restart r "bot" Bot.run

cabalにexecutableを追加して、これを読み込んで実行する構成にしてみた

.cabal

executable slacknowledge-devel  
  hs-source-dirs:      app
  main-is:             DevelMain.hs
  ghc-options:         -threaded -rtsopts -with-rtsopts=-N
  build-depends:       base
                     , slacknowledge
                     , rapid
  default-language:    Haskell2010

使う

stack ghci slacknowledge:lib slacknowledge:exe:slacknowledge-devel  
> up
listen 8080  
> :r
> up

速い！

2017-12-29: 追記

ghcidを使ってauto reload

ghcid --command="stack ghci slacknowledge:lib slacknowledge:exe:slacknowledge-devel" --reload=./templates/ --reload=src --test up

もっと速い！