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

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

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

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

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

slack botを作る
- slack-api packageが便利
Elasticsearchに保存・検索
- bloodhound packageが便利
web site作る
- servantでweb front作った
- api(servant) + spa等では無いのが(私の中で)新鮮
ghciを使ってhot reloadしながら素早く開発する　(おまけ)
- rapidが便利

slack botを作る

slack-apiを使った

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

withSlackHandleで必要になるSlackConfigにはApiTokenの指定が必要。 slackでAppを作り"Bot User OAuth Access Token"を使えば良い。
patternが複雑になってきたらpattern synonymを使うと便利(Pattern Synonyms for Dates and an IRC Bot)

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 <$> (hits . searchHits $ res)
    Left e -> throwError e

ここでは雑にsourceだけを取り出している

web site作る

servantを使用

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

もっと速い！

Menu