HaskellでのTDDを楽しくするライブラリ methodを作りました。

はじめに

Haskellでテスト駆動開発を行う際、純粋な関数は単体テストを書きやすいですが、
返り値がモナドの関数（この記事ではそのような関数をメソッドと呼びます）にたいして単体テストを書くのは簡単ではありません。

今回、メソッドに対して単体テストを書きやすくなるライブラリ methodを作成しました。

https://hackage.haskell.org/package/method

methodとは

methodでは a1 -> ... -> an -> m b型の関数のことをメソッドと呼びます。
ここでmはモナドです。(->) rモナドを除く大抵のモナドはサポートしていますが、独自のモナドをメソッドにするにはMethod型クラスを実装する必要があります。

モックの作成

methodでは任意のメソッドのモックをDSLで書くことができます。

import Test.Method
import RIO (throwString)

f,f' :: Int -> String -> IO String 
f = mockup $ do
  when (args ((==42), (=="hoge"))) `thenReturn` "piyo"
  when (args ((<0), anything)) `thenAction` throwString "negative value"
  throwNoStubShow $ when anything
  
-- 上記で以下と同じメソッドが作られる
f' 42 "hoge" = pure "piyo"
f' n _ | n < 0 = throwString "negative value"
f' n s = error $ "no stub found for argument: " ++ show (n,s)

モックでは定数値を返すことが多いので引数の名前を束縛しなくて良いのと、
想定外の値が来た時に引数の情報をログに残せるのが便利です。

実行してみるとこんな感じです。

>>> f 42 "hoge"
"piyo"
>>> f (-1) "piyo"
*** Exception: UnliftIO.Exception.throwString called with:

negative value
Called from:
  throwString (<interactive>:18:49 in interactive:Ghci1)
>>> f 1 "piyo"
*** Exception: no stub found for argument: (1,"piyo")
CallStack (from HasCallStack):
  error, called at src/Test/Method/Mock.hs:90:9 in mthd-0.2.0.0-9aa95798:Test.Method.Mock

モックの検証

methodではメソッドの呼び出しを監視して、そのメソッドがどの引数で何回呼ばれているかを検証することができます。

import Test.Method
import Test.Hspec

f :: Int -> String -> IO ()
f = mockup $ do
  when anything `thenReturn` ()

doit :: (Int -> String -> IO ()) -> IO ()
doit g = do
  g 10 "hoge"
  g 10 "piyo"
  g 2  "hoge"

spec :: Spec
spec = describe "doit" $ do
  it "calls g 10 \"piyo\" once" $ do
    logs <- withMonitor_ $ \monitor ->
      doit (watch monitor f)
    logs `shouldSatisfy` (==1) `times` call (args ((==10),(=="piyo")))
  it "calls g _ \"hoge\" twice" $ do
    logs <- withMonitor_ $ \monitor ->
      doit (watch monitor f)
    logs `shouldSatisfy` (==2) `times` call (args (anything,(=="hoge")))

フックの注入

また、テストとは直接関係ないですが、methodを使うとメソッドの呼び出し時に
フックを仕込むことができます。例えばログを仕込んでみましょう。

import Control.Method

injectLog :: (Method method, MonadIO (Base method), Show (Args method)) -> method -> method
injectLog = decorateBefore_ $ \args -> liftIO $ print args 

f :: Int -> String -> IO ()
f = injectLog $ \x y -> ...

g :: MonadIO m => String -> StateT Int m Bool
g = injectLog $ \s -> ...

メソッドの型によらず同じ関数でログが仕込めるので便利です。

チュートリアル

例として以下のような認証機能をテスト駆動開発で作ることを考えましょう。

signin

引数：ユーザ名username とパスワード password
返り値：Maybe User

• ユーザ名とパスワードがデータベースに登録されたものと一致すればJust Userを返す。
• ユーザが存在しない場合、パスワードが一致しない場合はNothingを返す。

signup

引数：ユーザ名usernameとパスワードpassword
返り値：Maybe User

• ユーザ名とパスワードを持つユーザをデータベースに登録して返す
• ユーザ名が既にデータベースに登録されている場合はユーザを登録せずNothingを返す
• パスワードが空文字列の場合、ランダムなパスワードを生成して登録する。

ここでUser型は以下のように定義されているとします。

User.hs

module User where

import Lens.Micro.Platform (makeLenses)
import RIO (Text)

data User = User
  { _username :: Username,
    _password :: Password -- 簡単のため平文パスワードとします。
  }
  deriving (Eq, Ord, Show)

type Username = Text

type Password = Text

makeLenses ''User

また、親切なことにあなたの同僚がデータベースにアクセスするコードを既に書いてくれたとしましょう。

UserRepository.hs

module UserRepository where

import User (User, Username)

findByUsername :: Username -> IO (Maybe User)
findByUsername = ...

createUser :: User -> IO ()
createUser = ...

手を動かしたい方は以下のコミットをチェックアウトして進めてみてください。

https://github.com/autotaker/start-haskell/releases/tag/tutorial-method-init

API設計

ナイーブな設計

さて、この機能を実装するためにどのようなAPIにするか考えましょう。

一番ナイーブな設計はIOモナドを使うことです。

Auth.hs

module Auth where

import User (Password, User, Username)

signin :: Username -> Password -> IO (Maybe User)
signin = error "Let's implement"

signup :: Username -> Password -> IO (Maybe User)
signup = error "Let's implement"

では試しにテスト駆動開発を始めるために一つ目の仕様を書いてみましょう。

AuthSpec.hs

module AuthSpec where

import Auth (signin)
import Test.Hspec (Spec, context, describe, it, shouldReturn)
import User (User (User))
import UserRepository (createUser)

spec :: Spec
spec = do
  describe "signin" $ do
    context "ユーザ名とパスワードが一致する時" $ do
      it "`Just user`を返す" $ do
        -- 準備：ユーザ名とパスワードをデータベースに登録する
        let user1 = User "user1" "password1"
        createUser user1
        -- 実行 & 検証
        signin "user1" "password1" `shouldReturn` Just user1
        

テストを実行してみます。

$ cabal test
...

Failures:

  test/AuthSpec.hs:12:7: 
  1) Auth.signin.ユーザ名とパスワードが一致する時 `Just user`を返す
       uncaught exception: ErrorCall
       To be implemented
       CallStack (from HasCallStack):
         error, called at src/UserRepository.hs:9:14 in start-haskell-0.1.0.0-inplace:UserRepository
       CallStack (from -prof):
         UserRepository.createUser (src/UserRepository.hs:9:1-38)
         UserRepository.CAF (<entire-module>)

期待するエラーは "Let's Implement"ですが、 "To be implemented"が返ってきています。

よく確認するとあなたの同僚は怠惰な性格だったようです。

UserRepository.hs

createUser :: User -> IO ()
createUser = error "To be implemented"

さらに残念なことにその同僚は１週間の休暇を取得しており、実装してもらうことはできません。

このテストは、同僚が仮に実装してくれたとしても以下のような問題があります。

• データベースがないと動かない
• 既に"user1"がデータベースに登録されているとcreateUser userが一意性違反のエラーで失敗する

参照コミット

依存性の排除

このままでは１週間実装が遅れてしまい上長に怒られてしまいます。
AuthモジュールからUserRepositoryの依存性を排除しましょう。

そのためにRIOモナドとHasパターンを使います。

Auth.hs

module Auth where

import Lens.Micro.Platform (Lens', makeLenses)
import RIO (RIO)
import User (Password, User, Username)

data UserRepository env = UserRepository
  { _findByUsername :: Username -> RIO env (Maybe User),
    _createUser :: User -> RIO env ()
  }

makeLenses ''UserRepository

class HasUserRepository env where
  userRepositoryL :: Lens' env (UserRepository env)

signin :: (HasUserRepository env) => Username -> Password -> RIO env (Maybe User)
signin = error "Let's implement"

signup :: (HasUserRepository env) => Username -> Password -> RIO env (Maybe User)
signup = error "Let's implement"

初見だとちょっと気持ちが分かりにくいですが、直接UserRepositoryの関数を呼ぶ代わりにインターフェースUserRepositoryを経由して呼ぶことで依存性を排除しています。

テストコードは以下のようになります。

AuthSpec.hs

module AuthSpec where

import Auth (HasUserRepository (userRepositoryL), UserRepository (UserRepository, _createUser, _findByUsername), signin)
import Lens.Micro.Platform (makeLenses)
import RIO (runRIO, throwString, (^.))
import Test.Hspec (Spec, context, describe, it, shouldReturn)
import User (User (User), username)

newtype Env = Env {_userRepository :: UserRepository Env}

makeLenses ''Env

instance HasUserRepository Env where
  userRepositoryL = userRepository

userRepositoryMock :: UserRepository env
userRepositoryMock =
  UserRepository
    { _findByUsername = \user ->
        if user == "user1"
          then pure $ Just user1
          else pure Nothing,
      _createUser = \user ->
        if user ^. username == "user1"
          then throwString "user1 is already registered"
          else pure ()
    }

user1 :: User
user1 = User "user1" "password1"

spec :: Spec
spec = do
  describe "signin" $ do
    context "ユーザ名とパスワードが一致する時" $ do
      it "`Just user`を返す" $ do
        -- 準備：ユーザが一人だけ登録されたデータベースのモック
        let env = Env userRepositoryMock
        -- 実行 & 検証
        runRIO env (signin "user1" "password1")
          `shouldReturn` Just user1

めでたくテストコードからUserRepositoryの依存性を排除することができました。

テストを実行してみましょう。

$ cabal test
...
Failures:

  test/AuthSpec.hs:36:7: 
  1) Auth.signin.ユーザ名とパスワードが一致する時 `Just user`を返す
       uncaught exception: ErrorCall
       Let's implement
       CallStack (from HasCallStack):
         error, called at src/Auth.hs:18:10 in start-haskell-0.1.0.0-inplace:Auth
       CallStack (from -prof):
         Auth.signin (src/Auth.hs:18:1-32)
         Auth.CAF (<entire-module>)

期待通り "Let's implement"のエラーが発生しました。

参照コミット

このまま進んでも良いのですが、userRepositoryMockがちょっとかっこ悪いですね。

今回紹介するmethodを使うと以下のように書けます。

userRepositoryMock :: UserRepository env
userRepositoryMock =
  UserRepository
    { _findByUsername = mockup $ do
        when (args (== "user1")) `thenReturn` Just user1
        when anything `thenReturn` Nothing,
      _createUser = mockup $ do
        when (args ((== "user1") . view username))
          `thenAction` throwString "user1 is already registered"
        when anything `thenReturn` ()
    }

参照コミット

テスト駆動開発: signin

ユーザ名とパスワードが一致する時Just userを返す。

さて、失敗するテストが書けたので実装していきましょう。

Auth.hs

-signin = error "Let's implement"
+signin usernm passwd = pure $ Just (User usernm passwd)

馬鹿のような実装ですが、テストは通ります。

ユーザ名とパスワードが一致しない時 Nothingを返す

テストが通ったので次の仕様を表すテストを追加します。

AuthSpec.hs

@@ -46,3 +46,11 @@ spec = do
         -- 実行 & 検証
         runRIO env (signin "user1" "password1")
           `shouldReturn` Just user1
+
+    context "ユーザ名とパスワードが一致しない時" $ do
+      it "`Nothing`を返す" $ do
+        -- 準備：ユーザが一人だけ登録されたデータベースのモック
+        let env = Env userRepositoryMock
+        -- 実行 & 検証
+        runRIO env (signin "user1" "invalid_password")
+          `shouldReturn` Nothing

テストを実行すると期待通り失敗します。

Failures:

  test/AuthSpec.hs:55:9: 
  1) Auth.signin.ユーザ名とパスワードが一致しない時 `Nothing`を返す
       expected: Nothing
        but got: Just (User {_username = "user1", _password = "invalid_password"})

まともな実装にしてテストを成功させます。

Auth.hs

diff --git a/src/Auth.hs b/src/Auth.hs
index 023e6ac..8887d3f 100644
--- a/src/Auth.hs
+++ b/src/Auth.hs
@@ -1,8 +1,9 @@
 module Auth where
 
+import Control.Monad.Trans.Maybe (MaybeT (MaybeT, runMaybeT))
 import Lens.Micro.Platform (Lens', makeLenses)
-import RIO (RIO)
-import User (Password, User (User), Username)
+import RIO (RIO, guard, view, (^.))
+import User (Password, User, Username, password)
 
 data UserRepository env = UserRepository
   { _findByUsername :: Username -> RIO env (Maybe User),
@@ -15,7 +16,11 @@ class HasUserRepository env where
   userRepositoryL :: Lens' env (UserRepository env)
 
 signin :: (HasUserRepository env) => Username -> Password -> RIO env (Maybe User)
-signin usernm passwd = pure $ Just (User usernm passwd)
+signin usernm passwd = runMaybeT $ do
+  method <- view (userRepositoryL . findByUsername)
+  user <- MaybeT $ method usernm
+  guard $ (user ^. password) == passwd
+  pure user
 
 signup :: (HasUserRepository env) => Username -> Password -> RIO env (Maybe User)
 signup = error "Let's implement"
\ No newline at end of file

findByUsernameメソッドを環境から取ってきて呼び出すのがポイントです。

テストが通ったので、ちょっとリファクタリングしましょう

signin usernm passwd = runMaybeT $ do
  method <- view (userRepositoryL . findByUsername)
  user <- MaybeT $ method usernm
  ...

環境からメソッドを取り出して呼び出すこのコードは頻出パターンです。
methodライブラリが提供するinvoke関数を使うと短く書くことができます。

user <- MaybeT $ invoke (userRepositoryL . findByUsername) usernm

参照コミット

ユーザ名が登録されていない時にNothingを返す

signinの最後の仕様を表すテストを追加します。

AuthSpec.hs

@@ -54,3 +54,11 @@ spec = do
         -- 実行 & 検証
         runRIO env (signin "user1" "invalid_password")
           `shouldReturn` Nothing
+
+    context "ユーザが登録されていない場合" $ do
+      it "`Nothing`を返す" $ do
+        -- 準備：ユーザが一人だけ登録されたデータベースのモック
+        let env = Env userRepositoryMock
+        -- 実行 & 検証
+        runRIO env (signin "user2" "password2")
+          `shouldReturn` Nothing

幸い、signinの実装は修正せずにこのテストをパスします。

最後にテストコードのリファクタリングをしましょう。 envの宣言が共通しているので
抜き出します。

AuthSpec.hs

@@ -33,6 +33,10 @@ userRepositoryMock =
         when anything `thenReturn` ()
     }
 
+-- 準備：ユーザが一人だけ登録されたデータベースのモック
+env :: Env
+env = Env userRepositoryMock
+
 user1 :: User
 user1 = User "user1" "password1"
 
@@ -41,24 +45,18 @@ spec = do
   describe "signin" $ do
     context "ユーザ名とパスワードが一致する時" $ do
       it "`Just user`を返す" $ do
-        -- 準備：ユーザが一人だけ登録されたデータベースのモック
-        let env = Env userRepositoryMock
         -- 実行 & 検証
         runRIO env (signin "user1" "password1")
           `shouldReturn` Just user1
 
     context "ユーザ名とパスワードが一致しない時" $ do
       it "`Nothing`を返す" $ do
-        -- 準備：ユーザが一人だけ登録されたデータベースのモック
-        let env = Env userRepositoryMock
         -- 実行 & 検証
         runRIO env (signin "user1" "invalid_password")
           `shouldReturn` Nothing
 
     context "ユーザが登録されていない場合" $ do
       it "`Nothing`を返す" $ do
-        -- 準備：ユーザが一人だけ登録されたデータベースのモック
-        let env = Env userRepositoryMock
         -- 実行 & 検証
         runRIO env (signin "user2" "password2")
           `shouldReturn` Nothing

参照コミット

テスト駆動開発: signup

次はsignupを実装していきましょう。

未登録のユーザ名でパスワードが空文字列でないの時

Just userを返す。

まず、返り値を確認するテストケースを追加します。

AuthSpec.hs

-user1 :: User
+user1, user2 :: User
 user1 = User "user1" "password1"
+user2 = User "user2" "password2"
 
 spec :: Spec
 spec = do
@@ -60,3 +61,10 @@ spec = do
         -- 実行 & 検証
         runRIO env (signin "user2" "password2")
           `shouldReturn` Nothing
+
+  describe "signup" $ do
+    context "登録されていないユーザ名の時" $ do
+      context "パスワードが空文字列でない時" $ do
+        it "`Just user`を返す" $ do
+          runRIO env (signup "user2" "password2")
+            `shouldReturn` Just user2

参照コミット

実行すると期待通り失敗します。

Failures:

  test/AuthSpec.hs:68:9: 
  1) Auth.signup.登録されていないユーザ名の時.パスワードが空文字列でない時 `Just user`を返す
       uncaught exception: ErrorCall
       Let's implement
       CallStack (from HasCallStack):
         error, called at src/Auth.hs:26:10 in start-haskell-0.1.0.0-inplace:Auth
       CallStack (from -prof):
         Auth.signup (src/Auth.hs:26:1-32)
         Auth.CAF (<entire-module>)

仮実装でテストを通します。

Auth.hs

-signup = error "Let's implement"
+signup usernm passwd = pure $ Just $ User usernm passwd

createUserを呼び出すこと

さて、仮実装では createUserメソッドを呼び出していません。
このメソッドを呼び出していない場合に失敗するテストを追加したいです。

この時に使えるのがMonitorです。これを使うと、
メソッドの呼び出しを記録してどの引数で何回呼び出されてたかを検証することができます。

AuthSpec.hs

@@ -68,3 +72,13 @@ spec = do
         it "`Just user`を返す" $ do
           runRIO env (signup "user2" "password2")
             `shouldReturn` Just user2
+
+        it "`createUser user`を呼び出す" $ do
+          logs <- runRIO env $
+            -- `Monitor`を新しく作成し、記録されたメソッド呼び出しのログを返す
+            withMonitor_ $ \monitor ->
+              -- `createUser`メソッドの呼び出しを監視する
+              local (userRepositoryL . createUser %~ watch monitor) $
+                void $ signup "user2" "password2"
+          -- ログ中で引数が`user2`と等しい呼び出しがちょうど一回あることをアサート
+          logs `shouldSatisfy` (== 1) `times` call (args (== user2))

参照コミット

実行すると期待通り失敗します。

Failures:

  test/AuthSpec.hs:84:11: 
  1) Auth.signup.登録されていないユーザ名の時.パスワードが空文字列でない時 `createUser user`を呼び出す
       predicate failed on: []

ログが空なのでメソッドが一回も呼び出されていないことがわかります。

テストを成功させましょう。

Auth.hs

@@ -23,4 +23,7 @@ signin usernm passwd = runMaybeT $ do
   pure user
 
 signup :: (HasUserRepository env) => Username -> Password -> RIO env (Maybe User)
-signup usernm passwd = pure $ Just $ User usernm passwd
+signup usernm passwd = do
+  let user = User usernm passwd
+  invoke (userRepositoryL . createUser) user
+  pure $ Just user

参照コミット

登録済みユーザのとき

Nothingを返す。

テストケースを追加して失敗させましょう。

AuthSpec.hs

+    context "登録ずみユーザ名の時" $ do
+      it "`Nothing`を返す" $ do
+        runRIO env (signup "user1" "password1")
+          `shouldReturn` Nothing

参照コミット

テストを実行すると、"user1"に対してcreateUserを呼び出して例外が投げられています。

Failures:

  test/AuthSpec.hs:87:7: 
  1) Auth.signup.登録ずみユーザ名の時 `Nothing`を返す
       uncaught exception: StringException
       UnliftIO.Exception.throwString called with:
       
       user1 is already registered
       Called from:
         throwString (test/AuthSpec.hs:36:24 in main:AuthSpec)

Auth.hs

 signup :: (HasUserRepository env) => Username -> Password -> RIO env (Maybe User)
-signup usernm passwd = do
+signup usernm passwd = runMaybeT $ do
   let user = User usernm passwd
-  invoke (userRepositoryL . createUser) user
-  pure $ Just user
+  mUser <- lift $ invoke (userRepositoryL . findByUsername) usernm
+  guard $ isNothing mUser
+  lift $ invoke (userRepositoryL . createUser) user
+  pure user

参照コミット

createUserを呼び出す

AuthSpec.hs

+      it "`createUser`を呼び出さない" $ do
+        logs <- runRIO env $
+          withMonitor_ $ \monitor ->
+            local (userRepositoryL . createUser %~ watch monitor) $
+              void $ signup "user1" "password1"
+        logs `shouldSatisfy` (== 0) `times` call anything

参照コミット

このケースはそのままの実装でパスします。

未登録ユーザでパスワードが空文字列の時

ランダムなパスワードを生成しJust userを返す。

ランダムなパスワードを生成するPasswordGeneratorインターフェースを作成し、
signupの依存関係に追加します。

PasswordGeneratorのgenerateメソッドは引数に生成するパスワードの長さを表す
整数を受け取ります。

Auth.hs

@@ -13,16 +13,24 @@ data UserRepository env = UserRepository
 
 makeLenses ''UserRepository
 
+newtype PasswordGenerator env = PasswordGenerator
+  {_generate :: Int -> RIO env Password}
+
+makeLenses ''PasswordGenerator
+
 class HasUserRepository env where
   userRepositoryL :: Lens' env (UserRepository env)
 
+class HasPasswordGenerator env where
+  passwordGeneratorL :: Lens' env (PasswordGenerator env)
+
 signin :: (HasUserRepository env) => Username -> Password -> RIO env (Maybe User)
 signin usernm passwd = runMaybeT $ do
   user <- MaybeT $ invoke (userRepositoryL . findByUsername) usernm
   guard $ (user ^. password) == passwd
   pure user
 
-signup :: (HasUserRepository env) => Username -> Password -> RIO env (Maybe User)
+signup :: (HasUserRepository env, HasPasswordGenerator env) => Username -> Password -> RIO env (Maybe User)
 signup usernm passwd = runMaybeT $ do
   let user = User usernm passwd
   mUser <- lift $ invoke (userRepositoryL . findByUsername) usernm

テストコードではPasswordGeneratorのモックを注入し、テストを追加します。

@@ -1,6 +1,6 @@
 module AuthSpec where
 
-import Auth (HasUserRepository (userRepositoryL), UserRepository (UserRepository, _createUser, _findByUsername), createUser, signin, signup)
+import Auth (HasPasswordGenerator (passwordGeneratorL), HasUserRepository (userRepositoryL), PasswordGenerator (PasswordGenerator, _generate), UserRepository (UserRepository, _createUser, _findByUsername), createUser, signin, signup)
 import Lens.Micro.Platform (makeLenses)
 import RIO (MonadReader (local), runRIO, throwString, view, void, (%~))
 import Test.Hspec (Spec, context, describe, it, shouldReturn, shouldSatisfy)
@@ -18,13 +18,19 @@ import Test.Method
   )
 import User (User (User), username)
 
-newtype Env = Env {_userRepository :: UserRepository Env}
+data Env = Env
+  { _userRepository :: UserRepository Env,
+    _passwordGenerator :: PasswordGenerator Env
+  }
 
 makeLenses ''Env
 
 instance HasUserRepository Env where
   userRepositoryL = userRepository
 
+instance HasPasswordGenerator Env where
+  passwordGeneratorL = passwordGenerator
+
 userRepositoryMock :: UserRepository env
 userRepositoryMock =
   UserRepository
@@ -39,11 +45,20 @@ userRepositoryMock =
 
 -- 準備：ユーザが一人だけ登録されたデータベースのモック
 env :: Env
-env = Env userRepositoryMock
+env = Env userRepositoryMock passwordGeneratorMock
+
+passwordGeneratorMock :: PasswordGenerator Env
+passwordGeneratorMock =
+  PasswordGenerator
+    { _generate =
+        mockup $
+          when anything `thenReturn` "random_password"
+    }
 
-user1, user2 :: User
+user1, user2, user2' :: User
 user1 = User "user1" "password1"
 user2 = User "user2" "password2"
+user2' = User "user2" "random_password"
 
 spec :: Spec
 spec = do
@@ -68,6 +83,10 @@ spec = do
 
   describe "signup" $ do
     context "登録されていないユーザ名の時" $ do
+      context "パスワードが空文字列の時" $ do
+        it "ランダムなパスワードを生成し`Just user`を返す" $ do
+          runRIO env (signup "user2" "")
+            `shouldReturn` Just user2'
       context "パスワードが空文字列でない時" $ do
         it "`Just user`を返す" $ do
           runRIO env (signup "user2" "password2")

参照コミット

実装します。

Auth.hs

@@ -32,7 +33,11 @@ signin usernm passwd = runMaybeT $ do
 
 signup :: (HasUserRepository env, HasPasswordGenerator env) => Username -> Password -> RIO env (Maybe User)
 signup usernm passwd = runMaybeT $ do
-  let user = User usernm passwd
+  passwd' <-
+    if T.null passwd
+      then lift $ invoke (passwordGeneratorL . generate) 10
+      else pure passwd
+  let user = User usernm passwd'
   mUser <- lift $ invoke (userRepositoryL . findByUsername) usernm
   guard $ isNothing mUser
   lift $ invoke (userRepositoryL . createUser) user

参照コミット

副作用の検証

最後に生成するパスワードの長さが10であることと、ランダムなパスワードでユーザを
作成していることを確認するテストを追加しましょう。

AuthSpec.hs

@@ -87,6 +87,19 @@ spec = do
         it "ランダムなパスワードを生成し`Just user`を返す" $ do
           runRIO env (signup "user2" "")
             `shouldReturn` Just user2'
+        it "`generate 10`を呼び出す" $ do
+          logs <- runRIO env $
+            withMonitor_ $ \monitor ->
+              local (passwordGeneratorL . generate %~ watch monitor) $
+                void $ signup "user2" ""
+          logs `shouldSatisfy` (== 1) `times` call (args (== 10))
+        it "ランダムなパスワードで`createUser user`を呼び出す" $ do
+          logs <- runRIO env $
+            withMonitor_ $ \monitor ->
+              local (userRepositoryL . createUser %~ watch monitor) $
+                void $ signup "user2" ""
+          logs `shouldSatisfy` (== 1) `times` call (args (== user2'))
+
       context "パスワードが空文字列でない時" $ do
         it "`Just user`を返す" $ do
           runRIO env (signup "user2" "password2")

参照コミット

幸運なことにテストはそのままで通りました。

最後にテストのログを確認してみましょう。

Auth
  signin
    ユーザ名とパスワードが一致する時
      `Just user`を返す
    ユーザ名とパスワードが一致しない時
      `Nothing`を返す
    ユーザが登録されていない場合
      `Nothing`を返す
  signup
    登録されていないユーザ名の時
      パスワードが空文字列の時
        ランダムなパスワードを生成し`Just user`を返す
        `generate 10`を呼び出す
        ランダムなパスワードで`createUser user`を呼び出す
      パスワードが空文字列でない時
        `Just user`を返す
        `createUser user`を呼び出す
    登録ずみユーザ名の時
      `Nothing`を返す
      `createUser`を呼び出さない

Finished in 0.0010 seconds
10 examples, 0 failures

このようにsignin/signupの仕様書ができました。

まとめ

• 依存性を排除するためにRIOモナドとHas-Patternを使おう
• methodを使うとメソッドのモックや呼び出しの検証が簡単にできます

是非ライブラリを使ってみてください。Issueお待ちしています。