Edited at

で、出たー!幽霊型だー!(Phantom Type)

More than 1 year has passed since last update.


はじめに

この記事はDenis Shevchenko氏の講演、The Way to Simplicity: How Haskell Simplifies Code Maintenance.を参考に書かせていただきました。


概要

この記事ではHaskellのデザインパターンの1つである幽霊型(Phantom Type)について取り上げたいと思います。

完成したコードはGitHubにもアップロードしているのでそちらも参照してみて下さい。

https://github.com/HirotoShioi/PhantomType

今回はメッセージの暗号及び復号を行うライブラリの開発を行い、開発する上で発生した問題を幽霊型を用いることで如何に解決できるかを紹介します。


初期実装

まずはMessage型を定義しましょう

data Message = Message String deriving Show

次にメッセージを暗号化し、それを復号する関数encrypt,decryptを実装しましょう。この記事では暗号化とは単にData.Charライブラリにあるord関数を用いてCharIntに置き換えること、そして復号とは逆にchr関数を用いてIntCharに戻すものとします。

まずはメッセージの暗号化です

encrypt :: Message -> Message

encrypt (Message c) = Message (encContent c)
where
encContent :: String -> String
encContent str = let toNum = map ord str
in foldr (\x acc -> show x ++ " " ++ acc) [] toNum

試しに動かしてみましょう

λ: let msg = Message "Hello world"

λ: encrypt msg
Message "72 101 108 108 111 32 87 111 114 108 100 "

いい感じですね!

次にメッセージを復号する関数です。これは暗号化の逆、つまり数字を読み取って文字に置き換えるという作業をすればいいだけです。

decrypt :: Message -> Message

decrypt (Message c) = Message (decContent c)
where
decContent :: String -> String
decContent str = let numList = words str
decryptC = map (chr . read @ Int)
in decryptC numList

試しに暗号化したメッセージを復号してみましょう

λ: let msg = Message "Hello world"

λ: decrypt $ encrypt msg
Message "Hello World"

完璧です


全然ダメです

そうですね。これではメッセージが暗号化されているのかどうかという情報が欠落しています。なので以下のような意図しない動作を許してしまいます。


n重暗号

これはつまり暗号化された文をさらに暗号化することです。これを許してしまうと暗号化関数が何度適用されたのかわからないため、メッセージの復号が困難になります。

λ: let msg = Message "Hello world"

λ: encrypt $ encrypt msg
Message "55 50 32 49 48 49 32 49 48 56 32 49 48 56 32 49 49 49 32 51 50 32 49 49 57 32 49 49 49 32 49 49 52 32 49 48 56 3249 48 48 32 "
λ: decrypt . encrypt $ encrypt msg
Message "72 101 108 108 111 32 119 111 114 108 100 "

もちろん実世界では平文を何度も暗号化するということはありえますが、プログラマーとしては


  • 何度暗号化したのか

  • n重暗号を許すのか

は制御したいところです。


平文を復号する

メッセージ文が平文であるかわからないので、平文を復号することも可能です。もちろんこれはエラーにつながります。

λ: let msg = Message "Hello world"

λ: decrypt msg
Message "*** Exception: Prelude.read: no parse


安易な実装

まずは安易な解決策としてMessage型にフラグとなるBool型のフィールドを追加し、これを利用してMessageの状態を管理してみましょう。

data Message = Message String Bool deriving Show

またユーザーがMessage値を定義する際に勝手にフラグを定めてしまっては困るので、スマートコンストラクタも必要となります

message :: String -> Message

message c = Message c False

次にencryptdecrypt関数を変更しましょう。

encrypt :: Message -> Message

encrypt (Message c isEnc) = if isEnc
then error "Message is already encrypted"
else Message (encContent c) True
where
encContent :: String -> String
encContent str = let toNum = map ord str
in foldr (\x acc -> show x ++ " " ++ acc) [] toNum

decrypt :: Message -> Message
decrypt (Message c isEnc) = if not isEnc
then error "Message is already decrypted"
else Message (decContent c) False
where
decContent :: String -> String
decContent str = let numList = words str
decryptC = map (chr . read @ Int)
in decryptC numList

エラー処理を追加したのでやや読みにくくなりました。

先ほどのエラーに対処できるか試してみましょう

λ: let msg = message "Hello world"

λ: encrypt $ encrypt msg
*** Exception: Message is already encrypted
CallStack (from HasCallStack):
error, called at EncryptNaive.hs:18:38 in main:EncryptNaive
λ: decrypt msg
*** Exception: Message is already decrypted
CallStack (from HasCallStack):
error, called at EncryptNaive.hs:27:38 in main:EncryptNaive

一応対処しています。


問題点

しかしこれではライブラリを利用する際に誤った使い方をしたとしてもコンパイルエラーとなりません

例えば以下のような記述であってもコンパイルが通ってしまいます。

-- 平文の復号

error1 :: Message
error1 = decrypt $ message "Hello word"

-- 二重暗号
error2 :: Message
error2 = encrypt $ encrypt $ message "Hello word"

ライブラリ開発者から見ればこれらは明らかに誤った使い方です。しかしencrypt及びdecrypt関数はMessage型を受け取ってMessage型を返す関数なのでコンパイルされてしまいます。

-- 引数Messageが平文なのか全くわからない

encrypt :: Message -> Message

-- 引数Messageが暗号文なのか全くわからない
decrypt :: Message -> Message

これを防ぐにはどうすれば良いのでしょうか。


幽霊型

ではencryptdecrypt関数にMessage型をそのまま与える代わりに型レベルMessage型の状態を表現することはできないでしょうか。つまり単にMessage型を渡すのではなくMessage 状態型を与えれば良いのです。

型レベルで状態を表現できれば:


  • もしMessageの状態がEncrypted(暗号文)であればencrypt関数はそのMessageを受け付けない

  • 逆にPlain(平文)であればdecrypt関数はそのMessageを受け付けない。

などが可能となり、誤った関数の使用を防ぐことができます。

この状態って型引数で表現できるんじゃないでしょうか?やってみましょう。

data Encrypted

data Plain

data Message a = Message String deriving Show

型引数aは左側にはありますが、右側の値コンストラクタにはありませんよね。この型引数a幽霊型と呼びます。

Messageの状態を表現するEncryptedPlain型はちょっと変わってますね。値コンストラクタがありません。でもよく考えればこの2つはMesssage型の状態を型レベルで表現するのが唯一の役割なので、値コンストラクタを必要としないのです。

それではこの幽霊型を利用してコードを再度書き換えましょう。

まずはスマートコンストラクタからです。

message :: String -> Message Plain

message = Message

すごくシンプルになりましたね。返す型がMessage Plain型であることに注目してください。

次にencryptdecrypt関数も書き換えます。

encrypt :: Message Plain -> Message Encrypted

encrypt (Message c) = Message (encContent c)
where
encContent :: String -> String
encContent str = let toNum = map ord str
in foldr (\x acc -> show x ++ " " ++ acc) [] toNum

decrypt :: Message Encrypted -> Message Plain
decrypt (Message c) = Message (decContent c)
where
decContent :: String -> String
decContent str = let numList = words str
decryptC = map (chr . read @ Int)
in decryptC numList

なんと型シグネチャ以外は全く書き換える必要がありませんでした。またエラー構文がなくなったので可読性も増しました。

これによって先ほどのerrorerror1を定義しようとすると期待通りコンパイルエラーとなります。

[1 of 1] Compiling EncryptPhantom   ( EncryptPhantom.hs, interpreted )

EncryptPhantom.hs:37:20: error:
• Couldn't match type ‘Plain’ with ‘Encrypted’
Expected type: Message Encrypted
Actual type: Message Plain
• In the second argument of ‘($)’, namely ‘message "Hello world"’
In the expression: decrypt $ message "Hello world"
In an equation for ‘error1’:
error1 = decrypt $ message "Hello world"
|
37 | error1 = decrypt $ message "Hello world"
| ^^^^^^^^^^^^^^^^^^^^

EncryptPhantom.hs:39:20: error:
• Couldn't match type ‘Encrypted’ with ‘Plain’
Expected type: Message Plain
Actual type: Message Encrypted
• In the second argument of ‘($)’, namely
‘encrypt $ message "Hello world"’
In the expression: encrypt $ encrypt $ message "Hello world"
In an equation for ‘error2’:
error2 = encrypt $ encrypt $ message "Hello world"
|
39 | error2 = encrypt $ encrypt $ message "Hello world"
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Failed, 0 modules loaded.

エラー文を読み解いてみましょう。

まずerror1ではdecrypt関数はMessage Encrypted型(暗号文)を引数としているのに、与えられたmessage "Hello world"の型がMessage Plain型(平文)であるため適用できないと言っています。

同様にerror2ではencrypt関数はMessage Plain型(平文)を引数としているのに、与えられたencrypt $ message "Hello world"の型がMessage Encrypted型(暗号文)であるため適用できないと言っています。

つまり幽霊型を利用することによってn重暗号、平文の復号を禁止することに成功したのです。

もう大丈夫ですね


いや、何かおかしい

その通りです。

Message型はMessage a型になってしまいました。aは型変数であるためMessage StringMessage Int型を定義することができます。

-- コンパイルが通ってしまう

wrong :: Message String
wrong = Message "Hello World"

この解決策はいたってシンプルです。Messageをモジュールとしてエクスポートしなければいいのです

module EncryptPhantom (

Message -- Not Message(..)
, Encrypted
, Plain
, message
, encrypt
, decrypt
) where

こうすればライブラリ利用者はMessage値を定義する際にスマートコンストラクタであるmessage関数を使う以外方法がないため、Message IntMessage String型のMessageを定義することができません。

試してみましょう

test :: Message Int

test = Message "Hello world"

これをコンパイルしようとするとエラーが出ます。

main.hs:12:8: error:

• Data constructor not in scope:
Message :: [Char] -> Message Int
• Perhaps you meant variable ‘message’ (imported from EncryptPhantom)
|
12 | test = Message "Hello world"
|

Message (..)をエクスポートしていないのでそもそも定義ができません。ライブラリ利用者がMessage値を定義するにはスマートコンストラクタであるmessage関数を利用する以外方法がありません。

test :: Message Plain

test = message "Hello world"


まとめ

幽霊型を利用することによってライブラリを誤った方法で使用しようとするとコンパイルエラーとなり、実行すらできなくなりました

つまりライブラリを正しく使用することをライブラリ利用者に強要させることに成功したのです。強要とは若干ネガティブな響きですが、逆に考えればコンパイル出来ればライブラリ開発者が意図した通りにライブラリを使用しているという自信を持つことができます。


最後に

最後に幽霊型の特徴をまとめます。


幽霊型


  • 幽霊型を利用することで型レベルで情報を付加することができる

  • 情報を付加することによって意図しない関数の利用を防ぐことができる

  • 付加された情報は値コンストラクタには存在しない。よって既存の関数の挙動に影響を与えない

  • コンパイラと友達になれる

これはあくまで幽霊型の利用方法の1つであって他にも実践的なパターンはいくつかあります。今回は幽霊型を用いてMessage型の状態を表現し、関数の誤った使用を防ぐことに成功しました。