• 作成:

Yesodのログを改善して解析しやすくする

Yesodの出力するログを改善したい(Yesodに限った話ではないが)

Yesodの出力するログをAmazon CloudWatch Logsで解析してDiscord(Slack互換APIを使う予定)に通知とかを行いたいと考えました。

それを行うためにはYesodのデフォルトの機械が解析しづらい構造をカスタムするのが手っ取り早そうですね。 JSON形式にすればCloudWatch Logs Insightsで解析しやすそうです。デフォルトの形式と戦うよりJSON形式のログを追加した方が誤爆や取り逃しの少ない実装を最終的に手っ取り早く実現できそうです。

Insightsでparseクエリを利用する手も無くは無いですが、サンプルの正規表現まみれのクエリを見てバグ無しで実装出来る気がしませんでした。自前のアプリケーションで出力を弄れるならそっちの方が良さそうです。

日時形式をISO 8601にします

Yesodの使用しているロガーであるmonad-loggerの基盤のfast-loggerのデフォルト日付フォーマットは、 newTimeCache の呼び出し時に決まります。

これがYesodに限った話ではないHaskell全般ポイントで、 fast-loggerを素直に使うとこうなってしまいます。

このデフォルト形式が22/Mar/2021:00:01:48のような私にはとてもつらい形式になっているので、 ISO 8601 - Wikipedia 形式に変えてやりましょう。

YesodやwaiがZonedDateと言う如何にも構造体じみた名前の型を使っていても、その実態は、

ZonedDate = FormattedTime = ByteString

なので、生のByteStringを使っているにすぎないのですよね。

これの初期化はdefaultMakeLoggerが行っています。

defaultMakeLogger :: IO Logger
defaultMakeLogger = do
    loggerSet' <- newStdoutLoggerSet defaultBufSize
    (getter, _) <- clockDateCacher
    return $! Logger loggerSet' getter

私のアプリケーションの場合amazonkaのログも一緒のログストリームに流したいのでAppappLoggerとして入れてるので、

makeLogger = return . appLogger

で、

  appLogger <- newStdoutLoggerSet defaultBufSize >>= \l -> do
    tgetter <- newTimeCache "%Y-%m-%dT%H:%M:%S%z"
    return $ Yesod.Core.Types.Logger l tgetter

と初期化すれば問題ありません。

clockDateCacherはfast-loggerの更新でnewTimeCacheを呼び出すための互換性確保のためだけの関数になっているので、直接newTimeCacheを呼び出してやります。

懸念があるとすると、 fast-loggerのデフォルトの形式が絶対固定であると思い込んだライブラリが日付処理などを間違ったりしないかなというものがありますが、とりあえず現状では問題ありませんでした。ログ出力を入力として使うライブラリはそうはないと思いますが…

エラーログにJSON出力を追加します

Yesodのエラーログ機構まとめ

型クラスYesodのメソッドのmessageLoggerSourcedefaultMessageLoggerSourceを呼び出して、フォーマットを行う本体であるformatLogMessageを呼び出しています。

messageLoggerSource :: site
                    -> Logger
                    -> Loc -- ^ position in source code
                    -> LogSource
                    -> LogLevel
                    -> LogStr -- ^ message
                    -> IO ()
messageLoggerSource site = defaultMessageLoggerSource $ shouldLogIO site
defaultMessageLoggerSource ::
       (LogSource -> LogLevel -> IO Bool) -- ^ Check whether we should
                                          -- log this
    -> Logger
    -> Loc -- ^ position in source code
    -> LogSource
    -> LogLevel
    -> LogStr -- ^ message
    -> IO ()
defaultMessageLoggerSource ckLoggable logger loc source level msg = do
    loggable <- ckLoggable source level
    when loggable $
        formatLogMessage (loggerDate logger) loc source level msg >>=
        loggerPutStr logger
formatLogMessage :: IO ZonedDate
                 -> Loc
                 -> LogSource
                 -> LogLevel
                 -> LogStr -- ^ message
                 -> IO LogStr
formatLogMessage getdate loc src level msg = do
    now <- getdate
    return $ mempty
        `mappend` toLogStr now
        `mappend` " ["
        `mappend` (case level of
            LevelOther t -> toLogStr t
            _ -> toLogStr $ drop 5 $ show level)
        `mappend` (if T.null src
            then mempty
            else "#" `mappend` toLogStr src)
        `mappend` "] "
        `mappend` msg
        `mappend` sourceSuffix
        `mappend` "\n"
    where
    sourceSuffix = if loc_package loc == "<unknown>" then "" else mempty
        `mappend` " @("
        `mappend` toLogStr (fileLocationToString loc)
        `mappend` ")"

なのでこれらとちょっと違う実装をねじこんでやれば追加が出来ます。

JSON出力実装

-- | 開発ではない環境ではJSON形式でもログを出力します
customMessageLoggerSource
  :: (LogSource -> LogLevel -> IO Bool) -- ^ Check whether we should
  -- log this
  -> Logger
  -> Loc -- ^ position in source code
  -> LogSource
  -> LogLevel
  -> LogStr -- ^ message
  -> IO ()
customMessageLoggerSource ckLoggable logger loc source level msg = do
  loggable <- ckLoggable source level
  when loggable $ do
    standardStr <- formatLogMessage (loggerDate logger) loc source level msg
    jsonStr <- if not development
               then formatLogMessageJson (loggerDate logger) loc source level msg
               else return ""
    loggerPutStr logger (standardStr <> jsonStr)

-- | CloudWatchの解析など向けにJSONでログをフォーマットします
formatLogMessageJson
  :: IO ZonedDate
  -> Loc
  -> LogSource
  -> LogLevel
  -> LogStr -- ^ message
  -> IO LogStr
formatLogMessageJson getdate loc src level msg = do
  now <- getdate
  let str = encode $ object
            [ "now" .= now
            , "level" .= showLevel level
            , "msg" .= fromLogStr msg
            , "src" .= src
            , "loc_package" .= loc_package loc
            , "loc_module" .= loc_module loc
            , "loc_line" .= line loc
            , "loc_char" .= char loc
            ]
  return $ toLogStr $ str <> "\n"
  where showLevel (LevelOther t) = toByteStringStrict t
        showLevel l              = toByteStringStrict $ drop 5 $ show l
        line = show . fst . loc_start
        char = show . snd . loc_start

これでJSONでもログが出るようになりました。まだ実際にCloudWatchで試してはいませんが、仮に間違っていても構造を把握したので修正は容易でしょう。

ソースは公開していますがこの関数どうしましょう

最初はOSSにして独立パッケージにしようかと思ったのですが、 CloudWatchのJSONが思ったより何でも受け入れるのでYesodをハックする部分以外特筆性が無かったので、独立パッケージにはなりませんでした。

問題なければYesod本体にPRを作るかもしれません。

埋め込みメトリックとか使うのかなと思ったのですが、これは単にログ出力でメトリックを作れるだけなので、書き捨てのLambdaとかならともかく継続したwebアプリケーションには不向きそうですね。どっちにしろコードで設定は書くわけですからね。

未解決問題

ログデータの内容として構造化データがある場合それを文字列に潰して出力するしかなさそうです。 monad-loggerのAPIがTextしか受け付けないので。インターフェイスの改造なしにバックエンドで対応しようとすると、文字列の中にタグを入れてそれを検知して無理やりキャストするようなつらいコードを書くしか無いですね。

monad-logger-json :: Stackage Server も単にJSONをシリアライズして出力するだけのようですし。