Tagless-final 方式を使って拡張可能 DSL を実現する

Haskell (GHC) 上で DSL (Domain Specific Language) を構築する際、操作の定義とその解釈（実行）の分離は強力な手法です。 しかし、一度定義した DSL に後から新しい操作を追加し、既存のプログラムを壊さずに拡張性を持たせるには、工夫が必要です。

この記事では、Free Monad を用いた DSL 構築の手法とその限界に触れた後、Tagless-Final 方式を用いて拡張可能な DSL を実現する方法を紹介します。

なお、この記事で例に挙げている、ghci で対話的に試すことができるコードは Github-Git*1 にアップロード済みです。

Free Monad による DSL の構築と限界

DSL の操作を連結するための一般的なアプローチとして、Free Monad を利用する方法があります。

まずは、ベースとなる Free Monad の実装を用意します。

data Free f a
  = Pure a
  | Nest (f (Free f a))
  deriving Functor

freeBind
  :: Functor f
  => Free f a -> (a -> Free f b) -> Free f b
Pure x  `freeBind` g = g x
Nest op `freeBind` g = Nest ( fmap (\x -> x `freeBind` g) op )

freeAp
  :: Functor f
  => Free f (a -> b) -> Free f a -> Free f b
freeAp m1 m2 = m1 `freeBind` \x1 -> m2 `freeBind` \x2 -> Pure (x1 x2)

instance Functor f => Applicative (Free f) where
  pure = Pure
  (<*>) = freeAp

instance Functor f => Monad (Free f) where
  (>>=) = freeBind

DSL1 の定義とプログラム例

この Free を使って、簡単な操作を行う DSL1 を定義してみましょう。 DSL1 は値の取り出し(GetI)、値の保存(PutI)、加算(Add) の機能を持っています。

data DSL1 a
  = GetI (Int -> a)
  | PutI Int a
  | Add Int (Int -> a)
  deriving Functor

getI :: Free DSL1 Int
getI = Nest $ GetI Pure

putI :: Int -> Free DSL1 ()
putI v = Nest $ PutI v (Pure ())

add :: Int -> Free DSL1 ()
add a = Nest $ Add a (\_ -> Pure ())

これらの操作を組み合わせて、DSL1 を使用したプログラム example1 を記述します。

example1 :: Free DSL1 ()
example1 = do
  putI 2         --  => 2
  v1 <- getI     --  v1 = 2
  add 3          --  => 3 + 2
  v2 <- getI     --  v2 = 5
  add (v1 + v2)  --  => ((2 + 5) + 5)

DSL1 の実行器

Free Monad によって組み上げた、DSL データ構造だけでは具体的な処理は行われません。 これに実際の振る舞いを与えるための実行器を定義します。

import Control.Monad.Trans.State

runF1 :: (Int -> Int) -> State Int Int
runF1 f = modify' f >> get

runDSL1_ :: Free DSL1 a -> State Int a
runDSL1_ (Pure x)           = return x
runDSL1_ (Nest (GetI f))    = get          >>= \v -> runDSL1_ (f v)
runDSL1_ (Nest (PutI v x))  = put v        >>        runDSL1_ x
runDSL1_ (Nest (Add a f))   = runF1 (a +)  >>= \v -> runDSL1_ (f v)

runDSL1 :: Free DSL1 a -> IO ()
runDSL1 f = print $ execState (runDSL1_ f) 0

ghci で実行すると、期待通りに状態が更新されていることがわかります。

ghci> runDSL1 example1
12

DSL2 への拡張と「閉じた直和型」の制約

次に、乗算(Mul) と出力(Prt) の機能を追加した DSL2 を定義することとします。

data DSL2 a
  = GetI (Int -> a)
  | PutI Int a
  | Add Int (Int -> a)
  | Mul Int (Int -> a)
  | Prt (Int -> a)
  deriving Functor

getI :: Free DSL2 Int
getI = Nest $ GetI Pure

putI :: Int -> Free DSL2 ()
putI v = Nest $ PutI v (Pure ())

add :: Int -> Free DSL2 ()
add a = Nest $ Add a (\_ -> Pure ())

mul :: Int -> Free DSL2 ()
mul a = Nest $ Mul a (\_ -> Pure ())

prt :: Free DSL2 ()
prt = Nest $ Prt (\_ -> Pure ())

DSL2 を使用したプログラム例 example2 は以下のようになります。

example2 :: Free DSL2 ()
example2 = do
  putI 2         --  => 2
  v1 <- getI     --  v1 = 2
  add 3          --  => 3 + 2
  prt
  v2 <- getI     --  v2 = 5
  mul (v1 + v2)  --  => ((2 + 5) * 5)

そして、DSL2 の実行器を実装します。Prt で IO を扱うため、StateT Int IO になっています。

runF1 :: (Int -> Int) -> StateT Int IO Int
runF1 f = modify' f >> get

runDSL2_ :: Free DSL2 a -> StateT Int IO a
runDSL2_ (Pure x)           = return x
runDSL2_ (Nest (GetI f))    = get          >>= \v -> runDSL2_ (f v)
runDSL2_ (Nest (PutI v x))  = put v        >>        runDSL2_ x
runDSL2_ (Nest (Add a f))   = runF1 (a +)  >>= \v -> runDSL2_ (f v)
runDSL2_ (Nest (Mul a f))   = runF1 (a *)  >>= \v -> runDSL2_ (f v)
runDSL2_ (Nest (Prt f))     = get          >>= \v -> lift (print v) >> runDSL2_ (f v)

runDSL2 :: Free DSL2 a -> IO ()
runDSL2 f = execStateT (runDSL2_ f) 0 >>= print

example1 と同様に ghci で実行することができます。

ghci> runDSL2 example2
5
35

しかし、ここで拡張性の問題に直面します。DSL2 の操作は DSL1 の操作を包含しているにもかかわらず、example1 を runDSL2 で直接実行することはできません。

Haskell の代数的データ型は「閉じた直和型」であり、OCaml の多相バリアント*2のような「開いた直和型」ではありません。そのため、Free DSL1 として構築された構造をそのまま Free DSL2 を期待する関数に渡すことはできず、両方の実行器に同時に適用できるような多相性を持ったプログラムを記述することができません。

Tagless-Final 方式による解決

Tagless-Final 方式*3 を使用すると、拡張性の問題を綺麗に解決できます。

Haskell で簡潔に Tagless-Final 方式を実現する場合、操作をデータ型として定義するのではなく、型クラスの拡張可能なインターフェースとして定義することになります。 Haskell の型クラスは superclass関係*4 を持てるため、機能の包含関係を、多相性を保って表現できます。

型クラスによる DSL の定義

class Monad m => DSL1 m where
  getI  :: m Int
  putI  :: Int -> m ()
  add   :: Int -> m ()

class DSL1 m => DSL2 m where
  mul   :: Int -> m ()
  prt   :: m ()

拡張可能なインターフェースとなっている型クラスのメソッドを使って記述することで、多相的な型を持ったプログラムを記述できます。

example1 :: DSL1 m => m ()
example1 = do
  putI 2
  v1 <- getI
  add 3
  v2 <- getI
  add (v1 + v2)

example2 :: DSL2 m => m ()
example2 = do
  putI 2
  v1 <- getI
  add 3
  prt
  v2 <- getI
  mul (v1 + v2)

example1 は DSL1 制約のみを要求しているため、DSL1 を満たす任意の実行器で動かすことができます。

拡張可能な実行器の実装

DSL1 のみを実行できる実行器 runBase と、DSL2 まで実行できる実行器 runExt を定義します。

newtype Base a
  = Base (State Int a)
  deriving (Functor, Applicative, Monad, MonadState Int)

instance DSL1 Base where
  getI = get
  putI = put
  add a = modify' (a +)

runBase :: Base a -> IO ()
runBase (Base s) = print $ execState s 0

-----

newtype Ext a
  = Ext (StateT Int IO a)
  deriving (Functor, Applicative, Monad, MonadState Int)

-- Ext は DSL1 と DSL2 両方のインスタンスにする
instance DSL1 Ext where
  getI = get
  putI = put
  add a = modify' (a +)

instance DSL2 Ext where
  mul a = modify' (a *)
  prt = get >>= Ext . lift . print

runExt :: Ext a -> IO ()
runExt (Ext s) = execStateT s 0 >>= print

実行結果

example1 は多相的に定義されているため、runBase と runExt のどちらの実行器でもそのまま実行できます。

ghci> runBase example1
12
ghci> runExt example1
12
ghci> runExt example2
5
35

拡張可能インターフェースを利用した多相型を使用し、拡張前と拡張後で、共有できるプログラムを記述できました。

DNS フルリゾルバ bowline での応用

私は Haskell で DNS フルリゾルバ bowline*5 を開発していますが、この Tagless-Final 方式はこの実装でも大いに役立っています。

パーサーのインターフェース拡張

bowline の設定ファイルの解釈器や、DNS Zonefile の解釈器のインターフェース定義*6に Tagless-Final 方式を使用しています。型クラスで拡張可能にしているため、例えば後からパフォーマンスの最適化を理由に try コンビネータといった新しい操作を既存のコードベースを破壊せずに追加することが容易です。

モナドの拡張インターフェースによる操作の制御

bowline の反復検索器のインターフェース定義*7にも使用しています。ここでは拡張性を利用して、「キャッシュへの操作のみが許可されているコンテキスト」と、「ネットワークの外部サーバーへ実際のクエリを行えるコンテキスト」を型レベルで厳密に区別しています。 具体的には、ネットワーク通信を行う部分は MonadQuery*8 という型クラスが実装されているかどうかで制限をかけ、意図しない呼び出しをコンパイル時に禁止しています。

このようにTagless-Final方式は、DSLに拡張性をもたらすだけでなく、型クラスの制約を通じて計算効果を安全に区別できる、実用性の高いパターンと言えます。

ランキング参加中
Haskell

*1: https://gist.github.com/khibino/b2997071aaa5d0afec0a46a2182c8d68

*2: https://ocaml.org/manual/5.4/polyvariant.html

*3: https://okmij.org/ftp/tagless-final/

*4: https://www.haskell.org/onlinereport/haskell2010/haskellch4.html#x10-760004.3.1

*5: https://iijlab.github.io/dnsext/

*6: https://github.com/iijlab/dnsext/blob/pre-release-20260209/dnsext-utils/DNS/Parser/Class.hs#L15-L32

*7: https://github.com/iijlab/dnsext/blob/pre-release-20260209/dnsext-iterative/DNS/Iterative/Query/Class.hs#L71-L82

*8: https://github.com/iijlab/dnsext/blob/pre-release-20260209/dnsext-iterative/DNS/Iterative/Query/Class.hs#L81-L82

非同期例外を境界スレッドで切り離す

GHC (Haskell) では、軽量スレッドを利用することで並行処理のプログラムを非常に手軽に記述できます。しかし、この強力な機能を素直に利用すると、思わぬ落とし穴にはまることがあります。

特に注意が必要なのが、Control.Concurrent モジュールの killThread :: ThreadId -> IO () や、 Control.Concurrent.Async モジュールの cancel :: Async a -> IO ()x の利用です。これらは対象の軽量スレッドに対して非同期例外を発生させ、実行中の IO アクションを強制的に中断させます。

本記事では、ネットワークサーバーのような「入出力を伴うセッションの実行」を例に取り、ナイーブな非同期例外による中断がどのような問題を引き起こすのかを確認し、その危険性を回避するためのアイデアを紹介します。

なお、この記事で例に挙げている ghci で対話的に試すことができるコードは、Github-Gist*1 にアップロード済みです。

ナイーブな非同期例外が引き起こす問題

次のような、入力の Mock と入出力セッションの実行器（sessionRunner）を考えてみます。この実行器は、入力が終わると入出力アプリケーションの IO アクションを 非同期例外で終了 させてしまうという特徴を持っています。

import Control.Concurrent
import Control.Concurrent.Async
import Control.Concurrent.STM
import Control.Applicative
import Control.Monad

import Data.IORef

import Data.Set (Set)
import qualified Data.Set as Set

msleep :: Int -> IO ()
msleep mills = threadDelay (mills * 1000)

data Input
  = Req Int
  | EndOfInput
  deriving (Eq, Show)

data Output
  = Resp Int
  deriving (Eq, Show)

-- 入力の Mock
genGetInput :: Int -> IO (IO Input)
genGetInput count = do
  ref <- newIORef 0
  return $ do
    i <- succ <$> readIORef ref
    if i <= count
      then writeIORef ref i >> return (Req i)
      else return EndOfInput

-- 入出力のセッションを実行する
sessionRunner
  :: (IO Input -> IO ())
  -> ((Output -> IO ()) -> IO ())
  -> IO ()
sessionRunner receiver sender = do
  getInput0 <- genGetInput 10
  done <- newEmptyMVar
  let getInput = do
        inp <- getInput0
        case inp of
          EndOfInput -> putMVar done ()
          Req {}     -> return ()
        return inp

  r <- async $ receiver $ do
    msleep 10
    getInput

  s <- async $ sender $ \_out -> do
    return ()

  takeMVar done
  -- 入力が終わると非同期に終了してしまう
  cancel s
  cancel r

そして、この実行器で動かすアプリケーションのコードとして、以下のような実装を用意します。 リクエストを受け取り、少し遅延を入れてからレスポンスを返す処理を並列に実行する、単純な処理です。

getApplication :: IO ( IO Input -> IO ()
                     , (Output -> IO ()) -> IO ()
                     , IO ())
getApplication = do
  pendings       <- newTVarIO Set.empty               :: IO (TVar (Set Int))
  results        <- newTQueueIO                       :: IO (TQueue Output)
  (eof, setEof)  <- do eofVar <- newEmptyTMVarIO      :: IO (TMVar ())
                       return (readTMVar eofVar, putTMVar eofVar ())

  let idispatch (Req n)     = do
        atomically (modifyTVar' pendings (Set.insert n))
        msleep ((n `rem` 5 + 1)  * 10)
        atomically (writeTQueue results (Resp n))
      idispatch  EndOfInput = atomically setEof
      runI inp = void $ forkIO (idispatch inp)

      receiver getInput = loop
        where loop = do
                inp <- getInput
                case inp of
                  Req {}     -> runI inp >> loop
                  EndOfInput -> runI inp

      runO out@(Resp n) = do
        print out
        atomically (modifyTVar' pendings (Set.delete n))
      -- sender の終了条件の判定
      done = do
        eof                                       -- 入力の終わりに到達 かつ
        guard . Set.null =<< readTVar pendings  -- 処理中のリクエストが無い
      sender send = loop
        where loop = do
                next <- atomically $
                        done *> return (return ())  -- 終了条件が成立するまではループを抜けない
                        <|>
                        do out <- readTQueue results
                           return (runO out >> send out >> loop)
                next

  let printResult = atomically (readTVar pendings) >>= \p ->  putStrLn ("pendings: " ++ show (Set.toList p))
  return (receiver, sender, printResult)

このアプリケーションのアクションを、実行器 sessionRunner にそのまま渡した場合どうなるでしょうか。

example1 :: IO ()
example1 = do
  (receiver, sender, printResult) <- getApplication
  sessionRunner receiver sender
  printResult

実行結果は以下のようになります。

ghci>  example1
Resp 1
Resp 2
Resp 5
Resp 3
Resp 6
Resp 4
Resp 7
pendings: [8,9,10]

入力が終了した時点で sessionRunner が即座に cancel を呼ぶため、アプリケーション側の sender が強制的に中断されてしまいます。その結果、バックグラウンドで処理中だった Req 8, Req 9, Req 10 の処理が完了せずに残ってしまいました。

解決策: 境界スレッドと STM による切り離し

このように、実行器がアプリケーションの IO アクションに対して直接非同期例外を投げてくるナイーブな設計は、処理の取りこぼしなどのバグを生みやすくなります。

そこで、この問題を回避するためのアーキテクチャを提案します。方針は 実行器に渡す IO アクションと、実際のアプリケーションの IO アクションを切り離す ことです。 (そして、この切り離された IO アクションは別のスレッドとなります)

具体的には、sessionRunner に渡された IO アクションが中断されることを前提とした上で、実行器と直接やり取りするための別のアクション（境界スレッド用の breceiver, bsender）を定義します。そして、アプリケーション本体との情報の受け渡しは、非同期例外の影響を受けない STM 変数（TQueue など）経由で行うようにします。

example2 :: IO ()
example2 = do
  input  <- newTQueueIO  :: IO (TQueue Input)
  -- sessionRunner に渡すための境界スレッド用入力 IO action
  let breceiver getInput = loop
        where loop = do
                inp <- getInput
                case inp of
                  Req {}     -> atomically (writeTQueue input inp) >> loop
                  EndOfInput -> atomically (writeTQueue input inp)
  output <- newTQueueIO  :: IO (TQueue Output)
  -- sessionRunner に渡すための境界スレッド用出力 IO action
  let bsender send = loop
        where loop = do
                send =<< atomically (readTQueue output) :: IO ()
                loop
  asess <- async $ sessionRunner breceiver bsender

  (receiver, sender, printResult) <- getApplication

  arecv <- async $ receiver (atomically (readTQueue input))
  asend <- async $ sender (\out -> atomically (writeTQueue output out))

  wait asess
  wait arecv
  wait asend

  printResult

実行結果は以下の通りです。

ghci> example2
Resp 1
Resp 2
Resp 5
Resp 3
Resp 6
Resp 4
Resp 7
Resp 10
Resp 8
Resp 9
pendings: []

sessionRunner にアプリケーションの IO アクションを直接渡さなくなったため、アプリケーション側は sessionRunner からの非同期例外の影響を直接受けなくなりました。不意の中断が起こらなくなったことで、すべてのリクエスト処理が安全に完了するようになっています。

DNSフルリゾルバ bowline での改善

筆者が開発している DNS フルリゾルバ bowline*2 においても、これと全く同じ構造の課題に直面しています。

bowline が利用している TLS や HTTP2 のトランスポートライブラリは、セッションの終了時に非同期例外を発行する構造になっています。 DoT*3 や DoH*4 の IO アクションに対して非同期例外が発行されることになるため、 ライブラリ側の終了条件と、bowline 側のセッションの終了条件が異なることがあると、難しい不具合が起きやすい構造を抱えてしまっています。

今後、紹介したような「非同期例外を境界スレッドで切り離す」パターンを適用することで、このセッション管理の堅牢性を改善していく予定です。

ランキング参加中
Haskell

*1: https://gist.github.com/khibino/f2e12af787bcd7aa3f76e9585c8aac57

*2: https://github.com/iijlab/dnsext

*3: https://github.com/iijlab/dnsext/blob/pre-release-20260209/dnsext-iterative/DNS/Iterative/Server/TLS.hs#L39-L78

*4: https://github.com/iijlab/dnsext/blob/pre-release-20260209/dnsext-iterative/DNS/Iterative/Server/HTTP2.hs#L40-L55

GHC eventlog をマルチスレッドのデバッグに活用する

Haskell で I/Oを伴うマルチスレッドプログラムを開発していると、タイミングに依存するバグや意図しない停止など、デバッグが非常に難しい問題に直面することがよくあります。

GHCのeventlog*1 と聞くと、ThreadScope*2 のようなツールに読み込ませてパフォーマンスのプロファイリングや並行性の可視化を行うための入力データ、という印象を持っている方も多いかもしれません*3。

しかし、eventlogにはRTS（ランタイムシステム）レベルの微細な挙動が記録されるため、その出力内容自体がマルチスレッドプログラムのデバッグにおいて非常に有用です。この記事では、デバッグ目的でのeventlogの活用方法を紹介します。

デバッグの役に立つ軽量スレッドのイベント

eventlogには、Haskellの軽量スレッドのライフサイクルに関する様々な情報が出力されます。特にデバッグで役立つのは以下のようなイベントです。

  • I/O 待ち等によるスレッドの停止（ブロック状態の確認）
  • スレッドの実行の開始
  • アプリケーションのロジックから任意のタイミングで出力するログ情報

これらのイベントを時系列で追跡することで、各スレッドのブロック理由や、アプリケーションの状態との関連を観測できます。

GHC の RTS の機能で eventlog を記録する

eventlogを記録するための手順は非常に簡単です。

まず、アプリケーションの実行時に RTS オプションとして -l（例: ユーザーイベントを記録する -lu など）を渡します。例えば +RTS -lu -RTS のように起動します*4。

嬉しいことに、最近の GHC RTS では、事前にコンパイラ（GHC）に -eventlog オプションを渡してビルドし直す必要がありません*5。標準でeventlogの記録が可能な状態になっています。

プログラムを実行すると <プログラム名>.eventlog というバイナリファイルが生成されるので、これを ghc-events コマンド*6 の inc サブコマンドなどを使って、人間が読めるテキスト形式で確認します。

% ghc-events --help
ghc-events --help:                        Display this help.
ghc-events inc <file>:                    Pretty print an event log incrementally
ghc-events inc force <file>:              Pretty print an event log incrementally. Retry on incomplete input (aka 'tail -f').
ghc-events show <file>:                   Pretty print an event log.
...

軽量スレッドの停止イベントの例

ghc-events で出力されたログを見ると、スレッドがどのような理由で停止したのかが記録されています。よく見かける例をいくつか紹介します。

FFI 呼び出しによる停止
cap 0: stopping thread 2 (making a foreign call)

FFIを呼び出したため、スレッドが一時的にブロックされている

STM 待ちによる停止
cap 0: stopping thread 12 (blocked in STM retry)

Software Transactional Memory (STM) のトランザクション内で retry が呼ばれ、STM 変数の更新を待つ

別スレッドへスケジュールを譲るための停止
cap 0: stopping thread 26 (thread yielding)

軽量スレッドの実行を一時的に停止し、RTSのスケジューラに別のスレッドの実行を促す

アプリケーション側からの情報の埋め込み

デフォルトのログだけでは thread 12 や thread 26 といったIDしか分からず、それがアプリケーション上のどの処理を担っているスレッドなのかが判別しづらいです。これを解決するための機能も用意されています。

スレッドに名前をつける

GHC.Conc.Sync モジュールが提供する labelThread :: ThreadId -> String -> IO () 関数を使うと、特定のスレッドに任意のラベルを割り当てることができます。この名前は eventlog にも記録されます。

出力例:

cap 3: thread 7 has label "bw.main"

アプリケーションのログを eventlog に流す

標準出力などに出す通常のログとは別に、 Debug.Trace モジュールの traceEventIO :: String -> IO () 関数を利用すると、RTSのイベントと完全に同期した形でアプリケーション側からのログを記録できます。

コード例:

eventLog s = do
    tid <- showTid <$> myThreadId
    traceEventIO ("uevent: thread " ++ tid ++ " (" ++ s ++ ")")

出力例:

cap 0: uevent: thread 208 ...

これにより、RTSが記録する「スレッドの停止・再開」のタイミングと、自作アプリケーションの内部ステートの変化を、一つの時系列上で突き合わせることが可能になります。

実例: DNSフルリゾルバ bowline での活用

私は現在、DNSフルリゾルバ bowline *7の開発を行っていますが、このプロジェクトでも eventlog をマルチスレッドのデバッグに活用しています。

具体的には、多数立ち上がる worker スレッドの状態変化を eventlog に記録する*8 ことで、問題が起きた状況の特定に役立てています。

実際のコードの一部は以下のような形です。worker スレッドの状態を書きかえる際に、eventlog にも出力しています。

setWorkerStatEV :: WorkerStatOP -> WorkerStat -> IO ()
setWorkerStatEV wstat st = do
    WStat.setWorkerStat wstat st
    eventLog $ "iter.st " ++ show st

RTSの状況を伴った形でアプリのログを記録できるeventlogは、デバッグの効率を大きく引き上げてくれます。 スレッドの停止理由などが可視化されるため、問題の解析の際に役立つ手段としておすすめです。

ランキング参加中
Haskell

*1: https://downloads.haskell.org/ghc/9.10.3/docs/users_guide/runtime_control.html#rts-eventlog

*2: https://wiki.haskell.org/ThreadScope

*3:例: Haskellによる並列・並行プログラミング https://www.oreilly.co.jp/books/9784873116891/ , 原著: Parallel and Concurrent Programming in Haskell https://www.oreilly.com/library/view/parallel-and-concurrent/9781449335939/

*4:https://downloads.haskell.org/ghc/9.10.3/docs/users_guide/runtime_control.html#rts-eventlog

*5:GHC 9.4 以降ではデフォルト https://downloads.haskell.org/ghc/9.10.3/docs/users_guide/phases.html?highlight=eventlog#ghc-flag--eventlog

*6:https://hackage.haskell.org/package/ghc-events

*7: https://iijlab.github.io/dnsext/

*8:https://github.com/khibino/dnsext/blob/pre-release-20260209/dnsext-iterative/DNS/Iterative/Server/Pipeline.hs#L187-L190

DNSSECの基本的な検証機能とその実装

DNSSEC - RRset の署名検証 - RRSIG(Resource Record Signature)

DNSSEC は RRset( RR(リソースレコード)のセット ) の内容を、利用者から検証可能にするための仕組みです.

DNSKEY RRには、そのゾーンで利用する公開鍵が登録され、RRSIG RR には RRset のタイプ(署名対象タイプ)とその署名値が登録されます.

RRset の利用者は、RRSIG RR が持つ署名値と DNSKEY RR が持つ公開鍵で署名検証を行なうことで、RRset がゾーンの管理者が署名した内容であることを確認することができます.

検証アルゴリズムでは、入力として RR の正規化ワイヤーフォーマット1の列2を処理することで、表現のゆれや圧縮の有無による不一致が起きないようにしています.

DNSSEC - 委任情報の検証 - DS(Delegation Signer)

委任元ゾーンでは、 DS RR に委任先ゾーンの DNSKEY RRのダイジェスト値が登録されるとともに、 DSタイプを署名対象にした RRSIG RR が登録されます.

これは、委任元がDS RRを介して委任先を署名していることを意味します.

DS RRが保持しているのは秘密鍵が無くとも計算できる DNSKEY RRのダイジェスト値であるため、 利用者が DS RRの内容を確認するには、RRSIG RRを使って検証する必要があります. DS RRとそれに対応するRRSIG RRは委任元のゾーンにあるため、検証は委任元の DNSKEY で行なうことになります.

DNSSEC - 不在証明 - NSEC3(NextSECure v.3)

NSEC3は、ドメインの不在を示すための仕組みです. ハッシュ化ドメイン名を使用することで、ゾーン全体の情報を簡単には取得できないようにしています.

NSEC3 RRは、ハッシュ化ドメイン名を所有者とし、そのゾーン内で存在する次のハッシュ化ドメイン名の先頭のラベルを保持します.

少し複雑ですが、このレコードは、以下を示しています.

ここでハッシュ化ドメイン名とハッシュ化ラベルは次の操作で計算します.

  1. 元のドメイン名の正規化ワイヤーフォーマット(RR内のドメイン名の正規化と同じ)を入力としてハッシュ値を計算3
  2. ハッシュ値を Base32Hex4 でエンコードし、アルファベットは小文字にする. これをハッシュ化ラベルとする
  3. ハッシュ化ラベルを先頭のラベルとしてゾーンのドメイン名を補う. これをハッシュ化ドメイン名とする

ハッシュ化後の比較に利用する順序関係には、DNS名の正規順序5を使用します.

NSEC3 RR はタイプビットマップを持っています. このフィールドから、所有者名が持つ RRset のタイプの一覧がわかるので、 ドメイン名は存在するけれども、タイプが無い NODATAの場合を示すこともできます.

このように、NSEC3 RR が有ることで、否定的な応答6を示すことができますが、 利用者がその内容を確認するには、対応する RRSIG RR で署名検証する必要があります.

DNSSEC - 不在証明 - NSEC(NextSECure)

NSECも、ドメインの不在を示すための仕組みです. ルートゾーンのような、ゾーン全体が公開されている場合に利用されています.

NSEC RRは、そのゾーン内で所有者のドメイン名の次のドメイン名を保持します. このレコードは、所有者のドメイン名と次のドメイン名の間にはドメイン名が存在しないことを示しています.

比較に利用する順序関係には、やはりDNS名の正規順序を使用します.

ハッシュ化が無い分 NSEC3 よりも簡単です.

NSEC3 RRと同様に、NSEC RR もタイプビットマップを持っています.

確認のために RRSIG RR で署名検証が必要なのも、NSEC3 の場合と同様です.

DNSSEC 検証機能の実装

dnsextライブラリ群7の dnsext-dnssec に DNSSEC の各検証機能を実装しました8

DNSSEC では、暗号アルゴリズムに割り当てられた番号ごとに、アルゴリズムを切り替えて処理を行ないます. アルゴリズムの追加拡張を可能にするために、暗号ライブラリモジュールごとに異なっている公開鍵の型や署名の型を、抽象化して吸収する必要があります.

GHC の ExistensialQuantification の拡張機能で、この抽象化をうまく行なうことができました. たとえば、RRSIG を検証するインターフェースは次のような存在型を利用しています.

data RRSIGImpl =
  forall pubkey sig .
  RRSIGImpl
  { rrsigIGetKey :: PubKey -> Either String pubkey
  , rrsigIGetSig :: Opaque -> Either String sig
  , rrsigIVerify :: pubkey -> sig -> ByteString -> Either String Bool
  }

存在型 pubkey と sig のところに暗号ライブラリ依存の公開鍵の型や署名の型を当て嵌めることで、 暗号ライブラリの型と切り離したインターフェースで、検証機能を実装することができました.

  1. Canonical RR Form https://datatracker.ietf.org/doc/html/rfc4034#section-6.2↩
  2. 次の定義で整列させます: Canonical RR Ordering within an RRset https://datatracker.ietf.org/doc/html/rfc4034#section-6.3↩
  3. Calculation of the Hash https://datatracker.ietf.org/doc/html/rfc5155#section-5↩
  4. Base 32 Encoding with Extended Hex Alphabet https://www.rfc-editor.org/rfc/rfc4648#section-7↩
  5. Canonical DNS Name Order https://datatracker.ietf.org/doc/html/rfc4034#section-6.1↩
  6. 否定応答については https://khibino.hatenadiary.jp/entry/2023/03/20/105555 を参照↩
  7. https://github.com/kazu-yamamoto/dnsext↩
  8. インターフェース https://github.com/khibino/dnsext/blob/dnssec-verify-impl/dnsext-dnssec/DNS/SEC/Verify/Types.hs, 実装 https://github.com/khibino/dnsext/blob/dnssec-verify-impl/dnsext-dnssec/DNS/SEC/Verify/Verify.hs↩

DNS の反復的な名前解決の仕組みとフルリゾルバの実装

ドメイン名の階層

DNS ではドメイン名に対する情報を管理します.

ドメイン名には階層があり、ドットで区切られたラベルの列の接尾辞がより上位の名前です. 最上位のドメイン名は "." です.

通常利用されているホスト名では、最上位の "." が省略されています. たとえば、"example.com" の省略をやめると "example.com." です. "example.com." は "com." から見て下位のドメイン名です. また、"example.com." と "com." は "." から見て下位のドメイン名です.

DNS ゾーン、DNS 権威サーバ、委任

DNS ゾーンとは、ドメイン名を頂点とする名前情報の管理単位で、より下位のドメイン名を管理します. この頂点のドメイン名をゾーン頂点(zone apex)と言います. DNS 権威サーバはゾーンの名前情報を管理します. 最上位のゾーン頂点は "." で、 このゾーンをルートゾーンといいます.

権威サーバはより下位のドメイン名のすべてを直接管理しているとは限らず、間接的な管理を行なっている場合があります. このとき、権威サーバは名前に対する情報を直接返す代わりに、下位のドメイン名を頂点とするゾーンの権威サーバの情報を返します. このような操作を委任と言い、その情報を委任情報と言います.

委任情報には、下位のドメイン名の権威サーバのドメイン名の情報を示すタイプNS のリソースレコード 1と、 権威サーバのアドレスの情報を示すタイプ A (IPv4アドレス) または AAAA (IPv6アドレス)のリソースレコードが含まれます. この、権威サーバのアドレスの情報を示すレコードを、グルーレコードと言います.

下位のドメイン名の権威サーバは、下位のドメイン名を持つ場合と、そうではないドメイン名を持つ場合があります. 下位のドメイン名を持つ場合には、グルーレコードが委任情報に含まれますが、 そうではないドメイン名を持つ場合には、グルーレコードは利用できません.

DNS の反復的な名前解決とフルリゾルバ

DNS で名前を解決するには、目的の'ドメイン名'と'タイプ'を指定し、次のような問い合わせの繰り返しの操作が必要です.2 この操作を反復的名前解決(iterative resolution)と言います.

  1. '問い合わせ先'をルートゾーンの権威サーバ、'ドメイン名'を目的のドメイン名のトップレベル("com.", "net.", "jp." 等)に設定して開始する
  2. 'ドメイン名'が目的のドメイン名なら、目的のタイプを問い合わせて終了.
  3. 'ドメイン名'とタイプA の問い合わせを行なう
  4. 問い合わせの結果、
    1. 委任情報が返らない場合、'ドメイン名'をより下位のドメイン名へと設定して、繰り返す. 2へ
    2. 委任情報が返った場合、'問い合わせ先'を委任先の権威サーバ3、 'ドメイン名'をより下位のドメイン名へと設定して、繰り返す. 2へ

DNS のフルリゾルバはこの反復的名前解決を行なう機能に加えて、問い合わせの結果のキャッシュを保持しているため、 直接は反復的な名前解決を行なうことができないクライアントのスタブリゾルバからの要求に対して、解決結果を提供することができます.

フルリゾルバの実装

Haskell で PoC として実装した反復的名前解決4とキャッシュ5 を組み合わせてフルリゾルバを実装しました. 6

次のプログラムは反復的名前解決うち、反復的に最終的な委任情報を得る部分を単純化したものです:

iterative :: Delegation  {- 初期値はルートゾーン -}
          -> [Name]      {- 上位から下位へのドメインリスト ex. ["com.", "example.com.", "www.example.com."] -}
          -> DNSQuery Delegation
iterative di0 []        = return di0
iterative di0 (name:ns) =
  step di0 >>=
  maybe
  (iterative di0 ns)  {- 委任情報が返らない無い場合は同じ委任情報を使う -}
  (\di -> iterative di ns)
  where
    step :: Delegation -> DNSQuery (Maybe Delegation)
    step di = do
      aa <- selectAuthAddr di
      msg <- queryAuth aa name A
      getDelegation name msg

{- 委任情報から権威サーバのアドレスを選ぶ.
   グルーレコードが利用できない場合は名前解決を再帰する -}
selectAuthAddr :: Delegation -> DNSQuery IP
{- 権威サーバから問い合わせ結果を得る -}
queryAuth :: IP -> Domain -> TYPE -> DNSQuery DNSMessage
{- 問い合わせ結果から委任情報を取り出す -}
getDelegation :: Domain -> DNSMessage -> QNSQuery (Maybe Delegation)

DNSメッセージのエンコード、デコード、およびスタブリゾルバには開発中のdnsextライブラリ群7 を利用しています.

キャッシュは優先度付きキューのライブラリであるpsqueues を利用して実現しています. キャッシュの実装の詳細な説明については https://khibino.hatenadiary.jp/entry/2023/03/20/105555#dns-full-resolver を参照してください.

フルリゾルバのサーバ機能は、次の 3種類のスレッドを連結することで実現しました.

  • 問い合わせDNSメッセージの受信とデコード
  • キャッシュ付きの反復的名前解決のワーカー
  • 返答DNSメッセージのエンコードと送信

Haskell の並行プログラミングの機能によって、フルリゾルバのサーバ機能を簡潔に実現することができました.

  1. DNS のリソースレコードについては別記事 https://khibino.hatenadiary.jp/entry/2023/03/20/105555#dns-rr を参照↩
  2. QNAME Minimisation Examples https://datatracker.ietf.org/doc/html/rfc9156#section-4↩
  3. 委任先の権威サーバが解決中の下位ドメイン名でない場合には、グルーレコードが利用できないため、同様の繰り返しで委任先の権威サーバのドメイン名の解決が必要↩
  4. https://github.com/khibino/dns-resolver/blob/tag/cache-server/src/DNSC/Iterative.hs↩
  5. https://github.com/khibino/dns-resolver/blob/tag/cache-server/src/DNSC/Cache.hs↩
  6. https://github.com/khibino/dns-resolver/blob/tag/cache-server/src/DNSC/Server.hs↩
  7. フルリゾルバの PoC 実装当時はdnsライブラリ を利用していましたが dnsext へと移行しました. またフルリゾルバのリポジトリを dnsext 下へ移動しました https://github.com/kazu-yamamoto/dnsext/tree/main/dnsext-full-resolver↩

DNS の否定応答とフルリゾルバへのネガティブキャッシュの組み込み

DNSのリソースレコードと名前解決

DNS ではドメイン名に関する情報としてリソースレコード(RR) を管理します. RR には ドメイン名、タイプ、クラス、生存期間を示す TTL、RDATA と呼ばれるタイプに応じた目的のデータが含まれています. 名前解決では問い合わせ内容となる (ドメイン名, タイプ, クラス) から RR を決定します.

例えば、ドメイン名 "example.com" の IPv4 アドレスを解決するなら、 ("example.com", A, IN) に対する RR を決定します. タイプ A は IPv4 アドレス用で、クラス IN はインターネットシステムをあらわします. 対応する RR の RDATA には IPv4 アドレスが入っています. 通常の運用ではクラスは IN を指定して利用され、他の値は一般的には使われていません. なので実際にはドメイン名とタイプが RR へ対応付けられることになります.

解決の結果となる RR は一つとはかぎらず、複数でもかまいません. 結果の RR が一つも無いこともあります.

DNSの否定応答とネガティブキャッシュ

DNS の否定応答には種類があり、SERVFAIL のような正常な結果が得られていないものと、 NODATA や NXDOMAIN といった正常な結果が得られているものがあります.

SERVFAIL は、なんらかの理由でシステムから、問い合わせに対する正常な結果を返せない状況です. NODATA は、そのドメイン名とタイプに対する RR は一つも無いけれども、同じドメイン名で別のタイプに対する RR が存在する場合です. NXDOMAIN は、どのようなタイプを指定したとしても、そのドメイン名に対する RR が一つも無い場合です.

DNS のネガティブキャッシュでは正常な結果が得られている NODATA と NXDOMAIN をキャッシュの対象とし、SERVFAIL は対象としません. 1 問い合わせに対する結果の RR が一つも無いという情報をキャッシュすることで、フルリゾルバの検索の回数を減らすことができます.

フルリゾルバのキャッシュとネガティブキャッシュの組み込み

開発中の Haskell によるフルリゾルバの実装では、優先度付きキューでキャッシュを実現していました. (Domain, TYPE, CLASS) をキー、[RData] を値、無効化時刻を優先度としています.

キャッシュ書き込み時には TTL と現在時刻から無効化時刻を計算して、優先度として書き込みます. キャッシュ読み出し時には無効化時刻と現在時刻から TTL を逆算することで、 [ResourceRecord] を復元できます.

ここに、ネガティブキャッシュを加えます.2

フルリゾルバの返答においても、ネガティブキャッシュの TTL をクライアント側へ知らせるために SOA とともに返すのが一般的です. キャッシュの情報から SOA を復元する必要があるため、優先度付きキューの値を [RData] から Either Domain [RData] へと変更しました.3 Right の場合が通常のキャッシュで、Left の場合がネガティブキャッシュです. Domain にはゾーンのドメイン名を入れておくことで、SOA を復元することができます.

キャッシュ書き込み時には、権威サーバからの SOA RR の TTL 値と MININUM フィールドのうちの小さい方を TTL として採用し、計算した無効化時刻を優先度として、 Left 付きのゾーンのドメイン名を書き込みます. キャッシュ読み出し時には、ゾーンのドメイン名から SOA を復元する他は、無効化時刻と現在時刻から TTL を逆算するのは通常のキャッシュと同様です.

NODATA の場合は、問い合わせの TYPE をそのままキーとして利用します. NXDOMAIN の場合は、問い合わせの TYPE 以外についても、RR が存在しないことを表現するため、Private Use の空間として定義されている4 TYPE の値を内部的に割り当てます. そうすることで、タイプに依らずにネガティブキャッシュを共有することができます.

  1. https://datatracker.ietf.org/doc/html/rfc2308#section-7↩
  2. ネガティブキャッシュ実装当時の変更内容 https://github.com/khibino/dns-resolver/compare/tag/empty-with-soa...tag/negative-cache↩
  3. 実装当時の型は、キャッシュ用の型への変換の都合で異なっています. ここではより整理された同型の定義をもとに説明しています.↩
  4. Private Use の空間は RFC6895 https://datatracker.ietf.org/doc/html/rfc6895#section-3.1 で定義される↩

GHC Generic Programming と代数的データ型

Haskell Advent Calendar 2016 の 12日目のエントリーです。

代数的データ型と Functor

Generic Programming は代数的データ型の構造を Functor の直積と直和のネスト構造に対応付けることで、 任意の代数的データ型に対する操作の記述を可能にする仕組みです。

まずは理解のために、より単純化した構造で考えてみましょう。

次のようなデータ型 ProdF f g a を考えると、 ProdF f g は Functor f および Functor g のもとで Functor になります。 これは、 もとの Functor のそれぞれの像の直積も Functor になる ということです。

ほぼ自明な内容ですが、 functor則を満たしていることを下に簡単に示してあります。

data ProdF f g a = ProdF (f a) (g a)

instance (Functor f, Functor g) => Functor (ProdF f g) where
  fmap f (ProdF p q) = ProdF (fmap f p) (fmap f q)

{-    fmap id
      {- ProdF の fmap の定義を unfold -}
   =  \(ProdF p q) -> ProdF (fmap id p) (fmap id q)
      {- Functor f および Functor g において fmap id == id -}
   =  \(ProdF p q) -> ProdF p q
   =  id

      fmap (f . g)
      {- ProdF の fmap の定義を unfold -}
   =  \(ProdF p q) -> ProdF (fmap (f . g) p) (fmap (f . g) q)
      {- fmap (f . g) == fmap f . fmap g -}
   =  \(ProdF p q) -> ProdF ((fmap f . fmap g) p) ((fmap f . fmap g) q)
      {- 関数合成の分離 -}
   =  (\(ProdF p q) -> ProdF (fmap f p) (fmap f q)) . (\(ProdF p q) -> ProdF (fmap g p) (fmap g q))
      {- ProdF の fmap の定義を fold -}
   =  fmap f . fmap g
 -}

Control.Applicative モジュールにある Const functor を使って ProdF (Const a) (Const b) x を考えると、これは値の直積 (a, b) と同型( 互いに変換してもプログラムの持つ意味を保存する )になることがわかります。 以下で、互いへの変換の関数の定義と、 その関数の合成が向きがどちらでも恒等関数になることを示しています。

prodFrom :: (a, b) -> ProdF (Const a) (Const b) x
prodFrom (p, q) = ProdF (Const p) (Const q)

prodTo :: ProdF (Const a) (Const b) x -> (a, b)
prodTo (ProdF (Const p) (Const q)) = (p, q)

{-
      prodFrom . prodTo $ ProdF (Const p) (Const q)
   =  prodFrom  (p, q)
   =  prodF (Const p) (Const q)
 -}

{-
      prodTo . prodFrom $ (p, q)
   =  prodTo  (ProdF (Const p) (Const q))
   =  (p, q)
 -}

このように直積の構造を functor の中に保存することが可能です。

直和の場合も考えてみましょう。

次のようなデータ型 SumF f g x を考えると、 SumF f g は Functor f および Functor g のもとでやはり Functor になります。 これは、 もとの Functor のそれぞれの像の直和も Functor になる ということです。

やはりほぼ自明な内容ですが、 functor則を満たしていることを下に簡単に示してあります。

data SumF f g x
  = SumL (f x)
  | SumR (g x)

instance (Functor f, Functor g) => Functor (SumF f g) where
  fmap f (SumL p) = SumL (fmap f p)
  fmap f (SumR q) = SumR (fmap f q)

{-    fmap id
      {- SumF の fmap の定義を unfold -}
   =  \x -> case x of { SumL p -> SumL (fmap id p) ; SumR q -> SumR (fmap id q) }
      {- Functor f および Functor g において fmap id == id -}
   =  \x -> case x of { SumL p -> SumL p ; SumR q -> SumR q }
   =  id

      fmap (f . g)
      {- SumF の fmap の定義を unfold -}
   =  \x -> case x of { SumL p -> SumL (fmap (f . g) p) ; SumR q -> SumR (fmap (f . g) q) }
      {- fmap (f . g) == fmap f . fmap g -}
   =  \x -> case x of { SumL p -> SumL ((fmap f . fmap g) p) ; SumR q -> SumR ((fmap f . fmap g) q) }
      {- 関数合成の分離 -}
   =  (\x -> case x of { SumL p -> SumL (fmap f p) ; SumR q -> SumR (fmap f q) }) .
      (\x -> case x of { SumL p -> SumL (fmap g p) ; SumR q -> SumR (fmap g q) })
      {- SumF の fmap の定義を fold -}
   =  fmap f . fmap g
 -}

こちらでも SumF (Const a) (Const b) x を考えると、これは値の直和 Either a b と同型になることがわかります。 直積の場合と同様に、互いへの変換の関数の定義と、 その関数の合成が向きがどちらでも恒等関数になることを示しています。

sumFrom :: Either a b -> SumF (Const a) (Const b) x
sumFrom (Left  p)  =  SumL (Const p)
sumFrom (Right q)  =  SumR (Const q)

sumTo :: SumF (Const a) (Const b) x -> Either a b
sumTo (SumL (Const p))  =  Left  p
sumTo (SumR (Const q))  =  Right q

{-
       sumFrom . sumTo $ SumL (Const p)
    =  sumFrom  (Left p)
    =  sumL p

       sumFrom . sumTo $ SumR (Const q)
    =  sumFrom  (Right q)
    =  sumL q
 -}

{-     sumTo . sumFrom $ Left p
    =  sumTo  (SumL (Const p))
    =  Left p

       sumTo . sumFrom $ Right q
    =  sumTo  (SumR (Const q))
    =  Right q
 -}

このように直和の構造も functor の中に保存することが可能です。

直積と直和の構造を情報を保存したままともに Functor にすることができたので、 これをさらに入れ子にすることで、与えられた任意の代数的データ型と同型になる Functor に変換できることがわかります。

GHC Generic Programming における定義

ここからは GHC.Generics モジュールに定義されている実際の Generic Programming 用の定義を使って見ていきましょう。

上の例での ProdF に対応するのが :*:、 SumF に対応するのが :+:、 Const に対応するのが K1 です。

これに加えて、コンストラクタの情報を保存するための型 M1 (フィールド 1つ以上) U1 (フィールド無し) が用意されています。

data (:*:) f g p = (f p) :*: (g p)
data (:+:) f g p = L1 (f p) | R1 (g p)
newtype K1 i c p = K1 {unK1 :: c}

data U1 p = U1
newtype M1 i c f p = M1 {unM1 :: f p}

代数的データ型と Functor の構造を互いに変換するための関数も見てみましょう。

% ghci
Prelude> import GHC.Generics
Prelude GHC.Generics> :t from
from :: Generic a => a -> Rep a x
Prelude GHC.Generics> :t to
to :: Generic a => Rep a x -> a

a が代数的データ型であるとすると Rep a はそれに対応した構造を持つ Functor です。 from は代数的データ型を Functor のネスト構造に変換し、 to はFunctor のネスト構造を代数的データ型に変換します。 Generic クラスのインスタンスは、 GHC の DeriveGeneric 拡張を使うことで生成することができます。

では直積の構造がどのような Functor に変換されているか見てみましょう。

Prelude GHC.Generics> :t from ( ('a', 1) :: (Char, Int) )
from ( ('a', 1) :: (Char, Int) )
  :: D1
       ('MetaData "(,)" "GHC.Tuple" "ghc-prim" 'False)
       (C1
          ('MetaCons "(,)" 'PrefixI 'False)
          (S1
             ('MetaSel
                'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
             (Rec0 Char)
           :*: S1
                 ('MetaSel
                    'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                 (Rec0 Int)))
       x

D1, C1, S1 は M1 の特殊化で、コンストラクタの情報です。 Rec0 は K1 の特殊化で、中にフィールド内の情報を保持しています。 :*: によってペア (Char, Int) の構造が保存されている様子が伝わるでしょうか。

直和の場合も見てみましょう。

Prelude GHC.Generics> :t from ( (Just 'x') :: Maybe Char )
from ( (Just 'x') :: Maybe Char )
  :: D1
       ('MetaData "Maybe" "GHC.Base" "base" 'False)
       (C1 ('MetaCons "Nothing" 'PrefixI 'False) U1
        :+: C1
              ('MetaCons "Just" 'PrefixI 'False)
              (S1
                 ('MetaSel
                    'Nothing 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy)
                 (Rec0 Char)))
       x

Nothing はフィールドが無いコンストラクタなので U1 が使われています。 :+: によって Just と Nothing の直和の構造が保存されている様子が伝わるでしょうか。

このように、Generic Programming を利用すると、 代数的データ型を直接操作する処理を書く代わりに、 Rep a x を操作する処理を書いておいて、 適切に from および to で変換することで、 任意の代数的データ型に対する汎用的な操作を書くことが可能となります。

GHC Generic Programming がどのように実現されているのかの理解の助けになればと思い、この記事を書いてみました。

ランキング参加中
Haskell