Haskell で Open Telemetry を利用してオブザーバビリティーを向上させよう

Open Telemetry って何?

この記事では Open Telemetry のトレースの機能を使います。トレースを使うと、サーバーを越境してコールグラフとその実行時間などを取得することができます。下の画像は Jaeger のスクリーンショットです。Jaeger は Open Telemetry の規格にのっとったコレクター実装のひとつです。

この例では HTTP サーバーと HTTP クライアントでトレースを取得しています。まずサーバーが /1 のパスでリクエストを受けつけたことが分かります。このリクエストに対してレスポンスを返すまでに 845μs かかっていますね。このトレースにおけるひとつの区間をスパンといいます。

次にサーバーはこのリクエストに対して処理をする途中で localhost:7777/2 に HTTP リクエストを投げたことが分かります。リクエストを投げてレスポンスが返ってくるまでに 729μs かかっています。

最後に /2 へのリクエストに対してサーバーが応答したスパンが記録されています。

この例では便宜上、サーバーは自分に対して再度リクエストをしていますが、これは物理的なサーバーが別であっても同様にトレースが取得できます。

Haskell のプログラムに対してトレースを記録したい

Open Telemetry はプログラミング言語や OS などに依存しない仕様ですから、Haskell でもトレースを記録したいです。そうすれば Istio や Node などのスパンとつながったトレースを見ることができます。Haskell では hs-opentelemetry ライブラリーを使用します。

github.com

自分もいっぱいコントリビュートしています。HERP 社からの委託を受け開発しています。

インターフェースは今後破壊的変更が入る可能性が多分にありますが、HERP 社で本番運用している程度に完成しています。

hs-opentelemetry の使い方

hs-opentelemetry はいくつかのパッケージに分かれています。まず基本となるものは hs-opentelemetry-api と hs-opentelemetry-sdk です。apisdk に分かれているのは Open Telemetry の仕様が分けるよう指示しているためであまり意味はありません。トレースを取得するためのトレーサーおよびトレーサーを作成するためのトレーサープロバイダーを作成するために使用します。また「ここからここまでスパンを取得する」というように手動で指定する場合に使用します。手動で指定するには下記の型をもつ inSpan 関数を使用します。

module OpenTelemetry.Trace.Core

…

inSpan ::
  (MonadUnliftIO m, HasCallStack) =>
  Tracer ->
  -- | The name of the span. This may be updated later via 'updateName'
  Text ->
  -- | Additional options for creating the span, such as 'SpanKind',
  -- span links, starting attributes, etc.
  SpanArguments ->
  -- | The action to perform. 'inSpan' will record the time spent on the
  -- action without forcing strict evaluation of the result. Any uncaught
  -- exceptions will be recorded and rethrown.
  m a ->
  m a

inSpan の第4引数の所要時間をスパンとして記録します。

これでスパンは記録できますが、全部を inSpan で書いていくのはいささか邪魔くさいです。そこでインスツルメンテーションが用意されています。初めのトレースの例では wai 用のインスツルメンテーションと http-client インスツルメンテーションを使用しています。インスツルメンテーションを使用すると初めのトレースの例の実装は下のようになります。

{-# LANGUAGE OverloadedStrings #-}

import qualified Network.HTTP.Client as H
import qualified Network.HTTP.Types.Status as H
import qualified Network.Wai as W
import qualified Network.Wai.Handler.Warp as W
-- Network.HTTP.Client の代わりに he-opentelemetry のインスツルメンテーションを使用する
import OpenTelemetry.Instrumentation.HttpClient (
  Manager (),
  defaultManagerSettings,
  httpLbs,
  newManager,
 )
-- he-opentelemetry のインスツルメンテーションで提供される WAI ミドルウェアを使用する
import OpenTelemetry.Instrumentation.Wai (newOpenTelemetryWaiMiddleware)
import OpenTelemetry.Trace (
  initializeTracerProvider,
  setGlobalTracerProvider,
 )


main :: IO ()
main = do
  -- デフォルト設定でトレーサープロバイダーを作成する
  tracerProvider <- initializeTracerProvider
  -- グローバルな IORef に作成したトレーサープロバイダーを参照させる
  setGlobalTracerProvider tracerProvider
  -- トレースが取れるようラップされた http-client を作成する
  httpClient <- newManager defaultManagerSettings
  -- トレースを取得する WAI ミドルウェアを作成する
  tracerMiddleware <- newOpenTelemetryWaiMiddleware
  W.run 7777 $ tracerMiddleware $ app httpClient


app :: Manager -> W.Application
app httpManager req res =
  case W.pathInfo req of
    ["1"] -> do
      newReq <- H.parseRequest "http://localhost:7777/2"
      newRes <- httpLbs newReq httpManager
      res $ W.responseLBS H.ok200 [] $ "1 (" <> H.responseBody newRes <> ")"
    ["2"] -> res $ W.responseLBS H.ok200 [] "2"
    _ -> res $ W.responseLBS H.ok200 [] "other"

app 関数はこれまで通りの書きごこちですが、HTTP リクエストを受けてレスポンスを返すまで、HTTP リクエストを投げてレスポンスを受けるまでのスパンが取得できるようになっています。簡単ですね。

インスツルメンテーションには他にも mysql-simple 版や grpc-haskell 版などが用意されています(というか作成しました)。また Datadog 仕様のトレースと接続するためにプロパゲーターなども用意されています(これも作成しました)。

実際に手元で動かしてみたい場合はリポジトリーの examples ディレクトリーを参照してください。

Open Telemetry を活用してオブザーバビリティーを上げていきましょう。

それではメリークリスマス!


これは Haskell アドベントカレンダー 2023 25日目の記事です。

qiita.com

wd コマンドをリリースした

wd コマンドって?

これがしたかった。

$ wd ディレクトリー コマンド オプション

とすると「ディレクトリー」をワーキングディレクトリーにして「コマンド」を「オプション」付きで実行する。

pushd でもできるけど popd と合わせるとタイプ数が多かった。

インストール

GitHub のリリースページに WindowsLinuxmacOS (x64) 用のバイナリーがある1

github.com

自分でビルドする場合は cabalghc が必要。

$ make install

気に入ったら GitHub にスターをよろしくね。


  1. GitHub Actions に macOS (ARM) が提供されるとそのバイナリーを追加するつもり。

Windows で Haskell SDL2

Hackage にある SDL2 ライブラリーを Windows で利用する方法のメモ。

hackage.haskell.org

Haskell-jpSlack の質問をきっかけに手元で試したことを思い出しながら書いている。

sdl2.cabal に下記の記述があるので C ライブラリーを事前にインストールする必要がある。

    pkgconfig-depends:
      sdl2 >= 2.0.6

今回は stack に附属する MSYS2 を利用する。

stack exec -- pacman -S mingw64/mingw-w64-x86_64-SDL2 でインストールできるはずだが、MSYS2 パッケージメンテナー入れ替えの影響で証明書のインストールをしないと次のようにエラーになることがある。

> stack exec -- pacman -S mingw-w64-x86_64-SDL2
…
error: mingw-w64-x86_64-mpfr: signature from "David Macek <david.macek.0@gmail.com>" is unknown trust
…
error: failed to commit transaction (invalid or corrupted package (PGP signature))
Errors occurred, no packages were upgraded.

MSYS2 のサイトに解決手順が書いてあるのでその通りにする。

www.msys2.org

そうすると stack exec -- pacman -S mingw64/mingw-w64-x86_64-SDL2 が成功する。

pkg-config 自体がインストールされてなかったので stack -- exec pacman -S mingw64/mingw-w64-x86_64-pkg-config でインストールする。

これで使用できるはずなので試してみる。

GitHub 上のリポジトリーに examples があるのでこれを実行する。

github.com

clone してきたディレクトリーで stack init して stack プロジェクトにする。

examples は無効になっているので下記のように stack.yaml を改変して有効にする。

- # flags: {}
+ flags:
+   sdl2:
+     examples: true

ビルドする。

> stack build
…
sdl2> copy/register
Installing library in C:\Users\kazuki\Projects\Sub\haskell-game\sdl2\.stack-work\install\723b28be\lib\x86_64-windows-ghc-9.0.2\sdl2-2.5.3.3-LQ1fiw2pm1OGrmM1xeYJnd
Installing executable twinklebear-lesson-01 in C:\Users\kazuki\Projects\Sub\haskell-game\sdl2\.stack-work\install\723b28be\bin
Installing executable lazyfoo-lesson-15 in C:\Users\kazuki\Projects\Sub\haskell-game\sdl2\.stack-work\install\723b28be\bin
Installing executable lazyfoo-lesson-14 in C:\Users\kazuki\Projects\Sub\haskell-game\sdl2\.stack-work\install\723b28be\bin
Installing executable twinklebear-lesson-04 in C:\Users\kazuki\Projects\Sub\haskell-game\sdl2\.stack-work\install\723b28be\bin
Installing executable lazyfoo-lesson-01 in C:\Users\kazuki\Projects\Sub\haskell-game\sdl2\.stack-work\install\723b28be\bin
Installing executable lazyfoo-lesson-08 in C:\Users\kazuki\Projects\Sub\haskell-game\sdl2\.stack-work\install\723b28be\bin
Installing executable lazyfoo-lesson-09 in C:\Users\kazuki\Projects\Sub\haskell-game\sdl2\.stack-work\install\723b28be\bin
Installing executable userevent-example in C:\Users\kazuki\Projects\Sub\haskell-game\sdl2\.stack-work\install\723b28be\bin
Installing executable lazyfoo-lesson-05 in C:\Users\kazuki\Projects\Sub\haskell-game\sdl2\.stack-work\install\723b28be\bin
Installing executable lazyfoo-lesson-03 in C:\Users\kazuki\Projects\Sub\haskell-game\sdl2\.stack-work\install\723b28be\bin
Installing executable lazyfoo-lesson-17 in C:\Users\kazuki\Projects\Sub\haskell-game\sdl2\.stack-work\install\723b28be\bin
Installing executable lazyfoo-lesson-02 in C:\Users\kazuki\Projects\Sub\haskell-game\sdl2\.stack-work\install\723b28be\bin
Installing executable audio-example in C:\Users\kazuki\Projects\Sub\haskell-game\sdl2\.stack-work\install\723b28be\bin
Installing executable lazyfoo-lesson-07 in C:\Users\kazuki\Projects\Sub\haskell-game\sdl2\.stack-work\install\723b28be\bin
Installing executable lazyfoo-lesson-10 in C:\Users\kazuki\Projects\Sub\haskell-game\sdl2\.stack-work\install\723b28be\bin
Installing executable lazyfoo-lesson-04 in C:\Users\kazuki\Projects\Sub\haskell-game\sdl2\.stack-work\install\723b28be\bin
Installing executable lazyfoo-lesson-19 in C:\Users\kazuki\Projects\Sub\haskell-game\sdl2\.stack-work\install\723b28be\bin
Installing executable lazyfoo-lesson-43 in C:\Users\kazuki\Projects\Sub\haskell-game\sdl2\.stack-work\install\723b28be\bin
Installing executable twinklebear-lesson-02 in C:\Users\kazuki\Projects\Sub\haskell-game\sdl2\.stack-work\install\723b28be\bin
Installing executable eventwatch-example in C:\Users\kazuki\Projects\Sub\haskell-game\sdl2\.stack-work\install\723b28be\bin
Installing executable lazyfoo-lesson-11 in C:\Users\kazuki\Projects\Sub\haskell-game\sdl2\.stack-work\install\723b28be\bin
Installing executable lazyfoo-lesson-12 in C:\Users\kazuki\Projects\Sub\haskell-game\sdl2\.stack-work\install\723b28be\bin
Installing executable lazyfoo-lesson-13 in C:\Users\kazuki\Projects\Sub\haskell-game\sdl2\.stack-work\install\723b28be\bin
Installing executable twinklebear-lesson-04a in C:\Users\kazuki\Projects\Sub\haskell-game\sdl2\.stack-work\install\723b28be\bin
Installing executable lazyfoo-lesson-18 in C:\Users\kazuki\Projects\Sub\haskell-game\sdl2\.stack-work\install\723b28be\bin
Installing executable twinklebear-lesson-05 in C:\Users\kazuki\Projects\Sub\haskell-game\sdl2\.stack-work\install\723b28be\bin
Registering library for sdl2-2.5.3.3..

実行する。

> stack exec lazyfoo-lesson-43

おわり

重ね着したバービー人形 in Haskell

うやむやで終わる記事なので事前にご了承ください。

前回のあらすじ

(前回などないので探さなくていいです。)

高カインドデータ型(Higher-kinded Datatypes; HKD)というものがあります。

fumieval.hatenablog.com

qiita.com

簡単に説明すると下記のようなデータ型 D があるとき

data D =
  D { a :: A
    , b :: B
    }

D の代わりに H のようなデータ型を作ると便利という発想です。

data H f =
  H { a :: f A
    , b :: f B
    }

H Identity だと D と同じ意味になりますし、H Maybe だと部分的に(もしくは全部)値が欠けたものを意味します。

HKD をサポートするライブラリーとして barbies がポピュラーです。

hackage.haskell.org

HD のように使うには Identity をたくさん書くことになりますが barbies の提供する機能を使うと Identity を書く手間が減らせます。

こういうものが用意されているので、

data Bare
data Covered

type family Wear t f a where
  Wear Bare    f a = a
  Wear Covered f a = f a

HB のように書き換えます。

data B b f =
  B { a :: Wear b f A
    , b :: Wear b f B
    }

このとき B Bare fD と同じ構造に B Covered fH と同じ構造になります。

こういうデータ型に対する操作も barbies は提供しています。

class FunctorB (b Covered) => BareB b where
  bstrip :: b Covered Identity -> b Bare Identity
  bcover :: b Bare Identity -> b Covered Identity

ここまでが「前回のあらすじ」です。

重ね着

ここからは「なんかこういうのがほしいな」という発展です。

data L f =
  L { a :: f A
    , d :: f (D f) -- D も HKD
    }

HKD が入れ子になっててもいいじゃない。

経緯としては、抽象構文木(Abstract Syntax Tree; AST)のデータ型を書いていて、位置情報を持つファンクター(例えば WithLocation とする)を f に与えるようにするとすっきりならんかと思いました。

data Expression f
  = Abstract
      { variable :: f Variable
      , expression :: f (Expression f)
      }
  | Application
      { expression1 :: f (Expression f)
      , expression2 :: f (Expression f)
      }

ファイルをパースして構築するときは Expression WithLocation として、テスト時は Expression Identity として使用します。

こうするとノードに付与する追加データと AST 自体の構造とが分離できて嬉しいです。

ここで barbies にあった Wear を使うとこうなります。

data Expression b f
  = Abstract
      { variable :: Wear b f Variable
      , expression :: Wear b f (Expression b f)
      }
  |

ここで ExpressionBareBインスタンスになるか考えます。

そのためには FunctorBインスタンスでないといけません。

FunctorB は次のような型クラスです。

class FunctorB b where
  bmap :: (forall a . f a -> g a) -> b f -> b g

Expression に対する bmap を実装してみます。

instance FunctorB (Expression Covered) where
  bmap f (Abstract v e) = Abstract (f v) (_ $ f e)
  bmap f (Application e1 e2) =

_ の部分の型は g (Expression Covered f) -> g (Expression Covered g) となるはずですが、うーん実装できなさそうです。

入れ子 HKD では bmap の型は Functor g => (forall a. f a -> g a) -> b f -> b g もしくは Functor f => (forall a. f a -> g a) -> b f -> b g となる必要がありそうです。

そんなわけで入れ子 HKD は barbies の提供する FunctorBBareB とは別の型クラスが必要となります。

さて、ここでリストを考えます。

newtype List x b f = List { unlist :: [Wear b f (x b f)] }

こういうデータ型があると、これに関して bmap を定義できて便利そうです。

同様にタプルについてもこんな Tuple2 を考えると……

newtype Tuple2 x y b f = Tuple2 { untuple2 :: (Wear b f (x b f), Wear b f (y b f)) }

というふうに考えて進めてたんですが、元の型と Wear 版の型との相互変換がいっぱいになったり、List x Bare Identity[] になってほしくなって型族を使いだしたりして収拾がつかなくなって一旦やめます、というお話です。

なんやそら。

Case Analysis 関数

今回は case analysis と呼ばれる関数の話です1

data D a b c
  = C0 a b
  | C1 c

例えば上記のようなデータ型があった場合 case analysis 関数は次のようになります。

d :: (a -> b -> d) -> (c -> d) -> D a b c -> d
d f _ (C0 a b) = f a b
d _ f (C1 c) = f c

値構築子の数だけ関数を引数とし、対象のデータを最後の引数とします。それぞれの関数の型は値構築子の型に似ます。

C0 :: a -> b -> D a b c
C1 :: c -> D a b c

d ::
  (a -> b -> d) -> -- C0 の型から決まる
  (c -> d) ->      -- C1 の型から決まる
  D a b c ->       -- 対象のデータ型
  d

使い方としては case 式でのパターンマッチの代わりにワンライナーとして使うことが多いです。次の2つのコードは等価です。

case v of
  C0 a b -> f a b
  C1 c -> g c
d f g v

base にある case analysis 関数としては次のようなものがあります。

Data.Bool.bool :: a -> a -> Bool -> a
Data.Maybe.maybe :: b -> (a -> b) -> Maybe a -> b
Data.Either.either :: (a -> c) -> (b -> c) -> Either a b -> c
Data.List.foldr :: (a -> b -> b) -> b -> [a] -> b -- 実際は多態、構築子と引数の順番が反対

  1. case analysis の名前は booleither のドキュメントで使われています。eliminator 派もあるようです。

続・刹那的純粋関数的データ構造と線形型

The English version is at Dev.


前回の記事の追加情報です。

kakkun61.hatenablog.com

pure 抜け道はなかった

まあ、こういうインターフェースでありがちな pure で外に出す抜け道が存在するのですが。

最後にこういうことを無思慮に書いたわけですが、Dev に書いた英語版を Reddit に載せたところ有益な情報を教えてもらえました。

www.reddit.com

I think the solution to the problem with empty might be to use the Ur (for "unrestricted") datatype from linear-base:

empty :: (Queue a #-> Ur b) #-> Ur b

Trying to run empty Ur shouldn't typecheck, because the Ur constructor is not linear. This seems to be an idiom used in other places of linear-base.

継続の返り値を Ur にすることで Queue を外に出せなくなります。Ur :: a -> Ur a に渡すと何回も使われるかもしれないため1回しか使えない Queue は渡すことができません。なるほどー。

CPS にしなくてよかった

生成する関数(ここでは empty)以外は CPS にしなくていいことに気付きました。

線形関数の中でその引数に別の線形関数を適用するとその返り値にも線形性が付くようです。この辺りちゃんと型付け規則を確認しないとな。

つまり、empty の継続 Queue a #-> Ur b の中で enqueue などを呼ぶとその返り値も1回しか使えないわけなので、enqueue などは CPS にしなくてよかったです。逆に nullBool は何回使ってもいいので Ur でくるみます。

null :: Queue a #-> (Ur Bool, Queue a)
null (Queue l m) = (Ur (P.null l), Queue l m)

enqueue :: a -> Queue a #-> Queue a
enqueue a (Queue l m) = check l (a:m)

dequeue :: Queue a #-> (Ur (Maybe a), Queue a)
dequeue (Queue (a:l) m) = (Ur (Just a), check l m)
dequeue (Queue l m) = (Ur Nothing, Queue l m)

そんなわけで使用感としてはこんな感じになりました。let 式が使えるなら見やすいのですが。

  it "empty → enqueue → dequeue" $ do
    let
      f :: Queue Int #-> Ur Int
      f q =
        enqueue 0 q PL.& \q ->
        dequeue q PL.& \(Ur (Just a), q) ->
        q `lseq` Ur a
      Ur a = empty f
    a `shouldBe` 0