diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,18 @@
 # Revision history for method
 
+## 0.3.0.0 -- 2021-02-22
+* Add new Protocol DSL to write communication specification between multiple methods. [\#5](https://github.com/autotaker/method/issues/5)
+  * Added new `Test.Method.Protocol` module.
+  * Generalize `thenReturn`, `thenAction`, and `thenMethod` by using `Behave` type class.
+  * Rename `throwNoStubShow` -> `throwNoStub` and `throwNoStub` -> `throwNoStubWithShow` to
+    keep consistency with `lookupMock`/`lookupMockWithShow`.
+* Add functions to mock polymorphic methods. [\#7](https://github.com/autotaker/method/issues/7)
+  * Added new `Test.Method.Dynamic` module.
+
+## 0.2.0.0 -- 2021-01-10
+* `throwNoStub` throws runtime exception instead of throwing exception via `MonadThrow`. [\#1](https://github.com/autotaker/method/issues/1)
+
+
 ## 0.1.0.0 -- 2021-01-09
 
 * First stable version
diff --git a/method.cabal b/method.cabal
--- a/method.cabal
+++ b/method.cabal
@@ -4,7 +4,7 @@
 -- For further documentation, see http://haskell.org/cabal/users-guide/
 
 name:               method
-version:            0.2.0.0
+version:            0.3.0.0
 synopsis:           rebindable methods for improving testability
 description:
   This package provides Method typeclass, which represents 
@@ -46,10 +46,13 @@
     Control.Method
     Control.Method.Internal
     Test.Method
+    Test.Method.Behavior
+    Test.Method.Dynamic
     Test.Method.Matcher
     Test.Method.Mock
     Test.Method.Monitor
     Test.Method.Monitor.Internal
+    Test.Method.Protocol
 
   -- other-modules:
   -- other-extensions:
@@ -64,7 +67,9 @@
 
   -- cabal-fmt: expand test -Spec
   other-modules:
+    Test.Method.DynamicSpec
     Test.Method.MockSpec
     Test.Method.MonitorSpec
+    Test.Method.ProtocolSpec
 
   build-depends:    method
diff --git a/src/Control/Method/Internal.hs b/src/Control/Method/Internal.hs
--- a/src/Control/Method/Internal.hs
+++ b/src/Control/Method/Internal.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
@@ -14,6 +15,8 @@
   )
 where
 
+import GHC.Generics (Generic)
+
 class TupleLike a where
   type AsTuple a
   fromTuple :: AsTuple a -> a
@@ -81,6 +84,6 @@
 
 -- | Tuple constructor
 data a :* b = a :* !b
-  deriving (Eq, Ord, Show)
+  deriving (Eq, Ord, Show, Generic)
 
 infixr 1 :*
diff --git a/src/Test/Method.hs b/src/Test/Method.hs
--- a/src/Test/Method.hs
+++ b/src/Test/Method.hs
@@ -8,7 +8,7 @@
 module Test.Method
   ( -- $usage
 
-    -- * Mock
+    -- * Mocking monomorphic methods
 
     -- ** Usage
     -- $mock
@@ -18,9 +18,21 @@
     thenReturn,
     thenAction,
     thenMethod,
-    throwNoStubShow,
+    throwNoStubWithShow,
     throwNoStub,
 
+    -- * Mocking polymorphic methods
+
+    -- ** Usage
+    -- $dynamic
+    DynamicShow,
+    Dynamic,
+    castMethod,
+    dynArg,
+    FromDyn (fromDyn),
+    ToDyn (toDyn),
+    Typeable,
+
     -- * Monitor
 
     -- ** Usage
@@ -42,6 +54,23 @@
     newMonitor,
     listenEventLog,
 
+    -- * Protocol
+
+    -- ** Usage
+    -- $protocol
+
+    -- ** References
+    protocol,
+    ProtocolM,
+    ProtocolEnv,
+    CallId,
+    decl,
+    whenArgs,
+    dependsOn,
+    lookupMock,
+    lookupMockWithShow,
+    verify,
+
     -- * Matcher
 
     -- ** References
@@ -58,6 +87,7 @@
   )
 where
 
+import Test.Method.Dynamic
 import Test.Method.Matcher
   ( ArgsMatcher (..),
     Matcher,
@@ -72,7 +102,7 @@
     thenMethod,
     thenReturn,
     throwNoStub,
-    throwNoStubShow,
+    throwNoStubWithShow,
   )
 import Test.Method.Monitor
   ( Event,
@@ -86,6 +116,18 @@
     withMonitor,
     withMonitor_,
   )
+import Test.Method.Protocol
+  ( CallId,
+    ProtocolEnv,
+    ProtocolM,
+    decl,
+    dependsOn,
+    lookupMock,
+    lookupMockWithShow,
+    protocol,
+    verify,
+    whenArgs,
+  )
 
 -- $usage
 -- This module provides DSLs for mocking
@@ -100,7 +142,7 @@
 --   'when' ('args' (\\x -> mod x 3 == 0)) `'thenReturn'` "fizz"
 --   'when' ('args' (\\x -> mod x 5 == 0)) `'thenReturn'` "buzz"
 --   'when' ('args' (>=0)) `'thenMethod'` (\\x -> pure $ show x)
---   'throwNoStubShow' $ 'when' 'anything'
+--   'throwNoStub' $ 'when' 'anything'
 -- @
 --
 -- >>> fizzbuzz 0
@@ -164,4 +206,172 @@
 --
 --   it "does not call example 3 \\\"bar\\\" " $ \\logs -> do
 --     logs `'shouldSatisfy'` ((==0) `'times'` 'call' ('args' ((==3), (=="bar"))))
+-- @
+
+-- $protocol
+-- Protocol is a DSL to write specification on communications between dependent methods.
+-- By using Protocol, you can specify
+--
+-- * how many times each method is called,
+-- * what arguments are passed for each call, and
+-- * in which order methods are called.
+--
+-- For example, let's test user creation logic @signup@.
+--
+-- @
+-- signup :: Service -> Username -> IO (Maybe UserId)
+-- signup svc username = ...
+-- type UserName = String
+-- type UserId = Int
+-- @
+--
+-- This method depends on @Service@, which consists of two methods.
+--
+-- * @findUser@: checks whether the user name is taken already,
+-- * @createUser@: creates a user with given user name.
+--
+-- @
+-- data Service = Service{
+--   findUser :: UserName -> IO (Maybe UserId),
+--   createUser :: UserName -> IO UserId
+-- }
+-- @
+--
+-- Let's check the following specification of @signup@ method.
+--
+-- 1. If @findUser@ returns @Just user@, it returns @Nothing@ without calling @createUser@.
+-- 2. If @findUser@ returns @Nothing@, it calls @createUser@ and returns the created user.
+--
+-- In order to write Protocol DSL, first you define a GADT functor that
+-- represents labels of dependent methods.
+--
+-- @
+-- data Methods m where
+--   FindUser :: Methods (UserName -> IO (Maybe UserId))
+--   CreateUser :: Methods (UserName -> IO UserId)
+--
+-- deriving instance (Show (Methods m))
+-- deriving instance (Eq (Methods m))
+-- deriving instance (Ord (Methods m))
+-- @
+--
+-- Then, you can write test for the specification.
+--
+-- @
+-- spec :: Spec
+-- spec = do
+--   describe "signup" $ do
+--     let username = "user1"
+--         userId = 1
+--     context "if ``findUser`` returns `Just user`" $
+--       it "return \`Nothing\` without calling ``createUser``" $ do
+--         -- Because env is stateful, it should be initialized for each test
+--         env <- 'protocol' $ do
+--           'decl' $ 'whenArgs' FindUser (==username) ``thenReturn`` Just userId
+--         -- mocking methods from protocol env. Each mock method raises an exception
+--         -- if it is called in a different way than that specified by the protocol.
+--         let service = Service {
+--               findUser = 'lookupMock' FindUser env,
+--               createUser = 'lookupMock' CreateUser env
+--             }
+--         signup service username \`shouldReturn\` Nothing
+--         -- Checks all calls specified by the protocol are called.
+--         'verify' env
+--
+--       it "call ``createUser`` and return `Just userId`" $ do
+--         env <- protocol $ do
+--           findUserCall <- 'decl' $ 'whenArgs' FindUser (==username) ``thenReturn`` Nothing
+--           'decl' $ 'whenArgs' CreateUser (==username) ``thenReturn`` Just userId ``dependsOn`` [findUserCall]
+--         let service = Service {
+--               findUser = 'lookupMock' FindUser env,
+--               createUser = 'lookupMock' CreateUser env
+--             }
+--         signup service username ``shouldReturn`` Just userId
+--         'verify' env
+-- @
+--
+-- Protocol DSL consists of method call declarations like:
+--
+-- @
+-- 'decl' $ 'whenArgs' FindUser (=="user1") ``thenReturn`` Nothing
+-- @
+--
+-- This declaration specifies that @findUser@ is called once with argument @"user1"@
+-- and it returns @Nothing@.
+-- If @findUser@ is called with other argument, it raises an exception.
+--
+-- In protocol DSL, you can specify in which order methods are called, by using 'dependsOn' function.
+-- For example:
+--
+-- @
+-- findUserCall <- 'decl' $ 'whenArgs' FindUser (=="user1") ``thenReturn`` Nothing
+-- 'decl' $ 'whenArgs' CreateUser (=="user1") ``thenReturn`` Nothing ``dependsOn`` [findUserCall]
+-- @
+--
+-- @findUser@ must be called before calling @createUser@.
+-- On the other hand, in the following example:
+--
+-- @
+-- 'decl' $ 'whenArgs' FindUser (=="user1") ``thenReturn`` Nothing
+-- 'decl' $ 'whenArgs' CreateUser (=="user1") ``thenReturn`` Nothing
+-- @
+--
+-- the order of calling two methods does not matter.
+--
+-- However, each call declaration implicitly depends on the previous call declaration of the same method.
+-- For example:
+--
+-- @
+-- 'decl' $ 'whenArgs' FindUser (=="user1") ``thenReturn`` Nothing
+-- 'decl' $ 'whenArgs' FindUser (=="user2") ``thenReturn`` Just 1
+-- @
+--
+-- @findUser "user1"@ must be called before @findUser "user2"@ is called.
+
+-- $dynamic
+-- Often you want to mock polymorphic functions.
+-- For example, assume that we are testing the following method.
+--
+-- @
+-- type QueryFunc = forall q r. (ToRow q, FromRow r) => Query -> q -> IO [r]
+-- service :: QueryFunc -> Day -> IO [Event]
+-- service query today = do
+--   events <- query "SELECT * FROM event WHERE date = ?" (Only today)
+--   pure events
+-- @
+--
+-- Because @QueryFunc@ is a polymorphic function, it is impossible to mock directly with 'mockup'.
+--
+-- In order to mock @QueryFunc@, first add 'Typeable' (and 'Show') constraint(s) for each type variables.
+--
+-- @
+-- type QueryFunc = forall q r. (ToRow q, 'Typeable' q, 'Show' q, FromRow r, 'Typeable' r, 'Show' r) => Query -> q -> IO [r]
+-- @
+--
+-- Next, we mock dynamic version of 'QueryFunc', where each type variable is replaced with 'DynamicShow'
+-- (or 'Dynamic').
+-- Finally, we obtain polymorphic method by casting
+-- the dynamic version with 'castMethod'.
+--
+-- @
+-- queryDyn :: Query -> 'DynamicShow' -> IO ['DynamicShow']
+-- queryDyn = 'mockup' $ ...
+-- queryMock :: QueryFunc
+-- queryMock = 'castMethod' queryDyn
+-- @
+--
+-- Now you can write test for @service@ as follows.
+--
+-- @
+-- spec :: Spec
+-- spec = do
+--   describe "service" $ do
+--     it "return events whose dates are equal to today" $ do
+--       let today = fromGregorian 2020 2 20
+--           sql = "SELECT * FROM event WHERE date = ?"
+--           events = [Event 0, Event 1]
+--           queryDyn :: Query -> 'DynamicShow' -> IO ['DynamicShow']
+--           queryDyn = mockup $
+--             when (args ((==sql), 'dynArg' (==today))) ``thenReturn`` 'toDyn' events
+--       service ('castMethod' queryDyn) today ``shouldReturn`` events
 -- @
diff --git a/src/Test/Method/Behavior.hs b/src/Test/Method/Behavior.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/Method/Behavior.hs
@@ -0,0 +1,42 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Test.Method.Behavior
+  ( Behave (..),
+    thenReturn,
+    thenAction,
+  )
+where
+
+import Control.Method (Method (Base, Ret, curryMethod))
+
+-- | A type class whose behavior is specified by a method
+class Behave x where
+  -- | Type of the first argument of 'thenMethod',
+  --   representing the condition when the method is called
+  type Condition x
+
+  -- | Type of the second argument of 'thenMethod',
+  --   representing a method to be called.
+  type MethodOf x
+
+  -- | Specify behavior from a pair of a condition and a method.
+  thenMethod :: Condition x -> MethodOf x -> x
+
+-- | Specify behavior that return a constant value for a call
+thenReturn ::
+  (Behave x, Method (MethodOf x)) =>
+  Condition x ->
+  Ret (MethodOf x) ->
+  x
+thenReturn lhs v =
+  thenMethod lhs $ curryMethod $ const $ pure v
+
+-- | Specify behavior that executes an action for a call
+thenAction ::
+  (Behave x, Method (MethodOf x)) =>
+  Condition x ->
+  Base (MethodOf x) (Ret (MethodOf x)) ->
+  x
+thenAction lhs action =
+  thenMethod lhs $ curryMethod $ const action
diff --git a/src/Test/Method/Dynamic.hs b/src/Test/Method/Dynamic.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/Method/Dynamic.hs
@@ -0,0 +1,226 @@
+{-# LANGUAGE DefaultSignatures #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+
+-- |
+-- Module : Test.Method.Dynamic
+-- Description:
+-- License: BSD-3
+-- Maintainer: autotaker@gmail.com
+-- Stability: experimental
+module Test.Method.Dynamic
+  ( DynamicShow,
+    Dynamic,
+    castMethod,
+    dynArg,
+    DynamicLike (..),
+    FromDyn (..),
+    ToDyn (..),
+    Typeable,
+  )
+where
+
+import Control.Method (Method (Args, Base, Ret, curryMethod, uncurryMethod))
+import Control.Method.Internal (type (:*))
+import Data.Dynamic (Dynamic)
+import qualified Data.Dynamic as D
+import Data.Typeable (Proxy (Proxy), Typeable, typeRep)
+import GHC.Generics
+  ( Generic (Rep, from, to),
+    K1 (K1),
+    M1 (M1),
+    U1 (U1),
+    type (:*:) ((:*:)),
+    type (:+:) (L1, R1),
+  )
+import Test.Method.Matcher (Matcher)
+
+-- | Dynamic value whose content is showable.
+-- Using this type instead of 'Dynamic' is recommended because it gives better error messages.
+data DynamicShow = DynamicShow !Dynamic String
+
+instance Show DynamicShow where
+  show (DynamicShow v s) = "<<" ++ s ++ " :: " ++ show (D.dynTypeRep v) ++ ">>"
+
+-- | @FromDyn a b@ provides a function to convert type @a@ to type @b@,
+-- where @b@ is a type whose dynamic type occurences are replaced by concrete types.
+--
+-- For example: @FromDyn (Int, Dynamic, Maybe Dynamic) (Int, Bool, Maybe String)@
+class FromDyn a b where
+  -- | convert dynamic value to specified type. It thows runtime exception if
+  -- the dynamic value does not have specified type.
+  fromDyn :: a -> b
+  default fromDyn :: (Generic a, Generic b, FromDyn' (Rep a) (Rep b)) => a -> b
+  fromDyn = to . fromDyn' . from
+
+-- | @ToDyn a b@ provides a function to convert type @b@ to type @a@, where
+-- @b@ is a type whose dynamic type occurences are replaced by concrete types.
+--
+-- For example: @ToDyn (Int, Dynamic, Maybe Dynamic) (Int, Bool, Maybe String)@
+class ToDyn a b where
+  -- | convert value of specified type to dynamic value
+  toDyn :: b -> a
+  default toDyn :: (Generic a, Generic b, ToDyn' (Rep a) (Rep b)) => b -> a
+  toDyn = to . toDyn' . from
+
+class FromDyn' f g where
+  fromDyn' :: f a -> g a
+
+class ToDyn' f g where
+  toDyn' :: g a -> f a
+
+instance (FromDyn' f f', FromDyn' g g') => FromDyn' (f :+: g) (f' :+: g') where
+  {-# INLINE fromDyn' #-}
+  fromDyn' (L1 a) = L1 (fromDyn' a)
+  fromDyn' (R1 b) = R1 (fromDyn' b)
+
+instance (FromDyn' f f', FromDyn' g g') => FromDyn' (f :*: g) (f' :*: g') where
+  {-# INLINE fromDyn' #-}
+  fromDyn' (a :*: b) = fromDyn' a :*: fromDyn' b
+
+instance (FromDyn a a') => FromDyn' (K1 i a) (K1 i a') where
+  {-# INLINE fromDyn' #-}
+  fromDyn' (K1 a) = K1 (fromDyn a)
+
+instance FromDyn' U1 U1 where
+  {-# INLINE fromDyn' #-}
+  fromDyn' _ = U1
+
+instance (FromDyn' f f') => FromDyn' (M1 i t f) (M1 i t f') where
+  {-# INLINE fromDyn' #-}
+  fromDyn' (M1 a) = M1 (fromDyn' a)
+
+instance Typeable a => FromDyn Dynamic a where
+  fromDyn = fromDynamic
+
+instance (Typeable a, Show a) => FromDyn DynamicShow a where
+  fromDyn = fromDynamic
+
+instance {-# INCOHERENT #-} FromDyn a a where
+  {-# INLINE fromDyn #-}
+  fromDyn = id
+
+instance (ToDyn' f f', ToDyn' g g') => ToDyn' (f :+: g) (f' :+: g') where
+  {-# INLINE toDyn' #-}
+  toDyn' (L1 a) = L1 (toDyn' a)
+  toDyn' (R1 b) = R1 (toDyn' b)
+
+instance (ToDyn' f f', ToDyn' g g') => ToDyn' (f :*: g) (f' :*: g') where
+  {-# INLINE toDyn' #-}
+  toDyn' (a :*: b) = toDyn' a :*: toDyn' b
+
+instance (ToDyn a a') => ToDyn' (K1 i a) (K1 i a') where
+  {-# INLINE toDyn' #-}
+  toDyn' (K1 a) = K1 (toDyn a)
+
+instance ToDyn' U1 U1 where
+  {-# INLINE toDyn' #-}
+  toDyn' _ = U1
+
+instance (ToDyn' f f') => ToDyn' (M1 i t f) (M1 i t f') where
+  {-# INLINE toDyn' #-}
+  toDyn' (M1 a) = M1 (toDyn' a)
+
+instance Typeable a => ToDyn Dynamic a where
+  toDyn = D.toDyn
+
+instance (Typeable a, Show a) => ToDyn DynamicShow a where
+  toDyn = toDynamicShow
+
+instance {-# INCOHERENT #-} ToDyn a a where
+  {-# INLINE toDyn #-}
+  toDyn = id
+
+instance (FromDyn a a', ToDyn b b') => ToDyn (a -> b) (a' -> b') where
+  toDyn f a = toDyn $ f (fromDyn a)
+
+instance (ToDyn a a', FromDyn b b') => FromDyn (a -> b) (a' -> b') where
+  fromDyn f a = fromDyn $ f (toDyn a)
+
+instance (FromDyn a b, FromDyn c d) => FromDyn (a :* c) (b :* d)
+
+instance (ToDyn a b, ToDyn c d) => ToDyn (a :* c) (b :* d)
+
+instance (FromDyn a b) => FromDyn [a] [b]
+
+instance (ToDyn a b) => ToDyn [a] [b]
+
+instance (FromDyn a b) => FromDyn (Maybe a) (Maybe b)
+
+instance (ToDyn a b) => ToDyn (Maybe a) (Maybe b)
+
+instance (FromDyn a a', FromDyn b b') => FromDyn (Either a b) (Either a' b')
+
+instance (ToDyn a a', ToDyn b b') => ToDyn (Either a b) (Either a' b')
+
+instance (FromDyn a a', FromDyn b b') => FromDyn (a, b) (a', b')
+
+instance (ToDyn a a', ToDyn b b') => ToDyn (a, b) (a', b')
+
+instance (FromDyn a a', FromDyn b b', FromDyn c c') => FromDyn (a, b, c) (a', b', c')
+
+instance (ToDyn a a', ToDyn b b', ToDyn c c') => ToDyn (a, b, c) (a', b', c')
+
+instance (FromDyn a a', FromDyn b b', FromDyn c c', FromDyn d d') => FromDyn (a, b, c, d) (a', b', c', d')
+
+instance (ToDyn a a', ToDyn b b', ToDyn c c', ToDyn d d') => ToDyn (a, b, c, d) (a', b', c', d')
+
+instance (FromDyn a a', FromDyn b b', FromDyn c c', FromDyn d d', FromDyn e e') => FromDyn (a, b, c, d, e) (a', b', c', d', e')
+
+instance (ToDyn a a', ToDyn b b', ToDyn c c', ToDyn d d', ToDyn e e') => ToDyn (a, b, c, d, e) (a', b', c', d', e')
+
+instance (FromDyn a a', FromDyn b b', FromDyn c c', FromDyn d d', FromDyn e e', FromDyn f f') => FromDyn (a, b, c, d, e, f) (a', b', c', d', e', f')
+
+instance (ToDyn a a', ToDyn b b', ToDyn c c', ToDyn d d', ToDyn e e', ToDyn f f') => ToDyn (a, b, c, d, e, f) (a', b', c', d', e', f')
+
+instance (FromDyn a a', FromDyn b b', FromDyn c c', FromDyn d d', FromDyn e e', FromDyn f f', FromDyn g g') => FromDyn (a, b, c, d, e, f, g) (a', b', c', d', e', f', g')
+
+instance (ToDyn a a', ToDyn b b', ToDyn c c', ToDyn d d', ToDyn e e', ToDyn f f', ToDyn g g') => ToDyn (a, b, c, d, e, f, g) (a', b', c', d', e', f', g')
+
+-- | convert a dynamically-typed method to a polymorphic method.
+--
+--   @
+--   fDyn :: String -> DynamicShow -> Dynamic -> IO [DynamicShow]
+--   fDyn = ...
+--   fPoly :: (Typeable a, Show a, Typeable b, Typeable c, Show c) => String -> a -> b -> IO [c]
+--   fPoly = castMethod fDyn
+--   @
+castMethod ::
+  ( ToDyn (Args method) (Args method'),
+    FromDyn (Ret method) (Ret method'),
+    Method method,
+    Method method',
+    Base method ~ Base method'
+  ) =>
+  method ->
+  method'
+castMethod method = curryMethod $ \args ->
+  fromDyn <$> uncurryMethod method (toDyn args)
+
+fromDynamic :: forall a d. (Typeable a, DynamicLike d, Show d) => d -> a
+fromDynamic v =
+  D.fromDyn (asDyn v) $
+    error $ "cannot cast " ++ show v ++ " to " ++ show (typeRep (Proxy :: Proxy a))
+
+toDynamicShow :: (Typeable a, Show a) => a -> DynamicShow
+toDynamicShow a = DynamicShow (D.toDyn a) (show a)
+
+-- | Generalizes 'Dynamic' and 'DynamicShow'
+class DynamicLike a where
+  asDyn :: a -> Dynamic
+
+instance DynamicLike Dynamic where
+  asDyn = id
+
+instance DynamicLike DynamicShow where
+  asDyn (DynamicShow a _) = a
+
+-- | Convert given matcher to dynamic matcher. The dynamic matcher
+-- matches a dynamic value only if the value has the type of given matcher.
+dynArg :: (Typeable a, DynamicLike b) => Matcher a -> Matcher b
+dynArg matcher dv =
+  maybe False matcher $ D.fromDynamic $ asDyn dv
diff --git a/src/Test/Method/Mock.hs b/src/Test/Method/Mock.hs
--- a/src/Test/Method/Mock.hs
+++ b/src/Test/Method/Mock.hs
@@ -1,5 +1,8 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeFamilies #-}
 
 -- |
@@ -12,26 +15,37 @@
 -- DSL to generate mock methods.
 module Test.Method.Mock
   ( Mock,
-    MockSpec,
+    MockM,
     mockup,
     thenReturn,
     thenAction,
     thenMethod,
-    throwNoStubShow,
+    throwNoStubWithShow,
     throwNoStub,
   )
 where
 
 import Control.Method
-  ( Method (Args, Base, Ret, curryMethod, uncurryMethod),
+  ( Method (Args, curryMethod, uncurryMethod),
     TupleLike (AsTuple, toTuple),
   )
 import RIO.List (find)
 import RIO.Writer (MonadWriter (tell), Writer, execWriter)
+import Test.Method.Behavior (Behave (Condition, MethodOf, thenMethod), thenAction, thenReturn)
 import Test.Method.Matcher (Matcher)
 
-type Mock method = Writer (MockSpec method) ()
+type Mock method = MockM method ()
 
+newtype MockM method a = MockM (Writer (MockSpec method) a)
+
+deriving instance (Functor (MockM method))
+
+deriving instance (Applicative (MockM method))
+
+deriving instance (Monad (MockM method))
+
+deriving instance (MonadWriter (MockSpec method) (MockM method))
+
 data MockSpec method
   = Empty
   | Combine (MockSpec method) (MockSpec method)
@@ -47,53 +61,33 @@
 -- Mock DSL consists of rules.
 -- On a call of generated method, the first rule matched the arguments is applied.
 mockup :: (Method method) => Mock method -> method
-mockup spec = buildMock (execWriter spec)
+mockup (MockM spec) = buildMock (execWriter spec)
 
 buildMock :: Method method => MockSpec method -> method
 buildMock spec = fromRules $ toRules spec
 
--- | @matcher `'thenReturn'` value@ means the method return @value@
--- if the arguments matches @matcher@.
-thenReturn :: (Method method, Applicative (Base method)) => Matcher (Args method) -> Ret method -> Mock method
-thenReturn matcher retVal =
-  tell $ MockSpec matcher $ curryMethod (const $ pure retVal)
-
--- | @matcher `'thenAction'` action@ means the method executes @action@
--- if the arguments matches @matcher@.
-thenAction ::
-  Method method =>
-  Matcher (Args method) ->
-  Base method (Ret method) ->
-  Mock method
-thenAction matcher ret =
-  tell $ MockSpec matcher $ curryMethod $ const ret
-
--- | @matcher `'thenMethod'` action@ means the method call @method@ with the arguments
--- if the arguments matches @matcher@.
-thenMethod :: (Method method) => Matcher (Args method) -> method -> Mock method
-thenMethod matcher method = tell $ MockSpec matcher method
+instance a ~ () => Behave (MockM method a) where
+  type Condition (MockM method a) = Matcher (Args method)
+  type MethodOf (MockM method a) = method
+  thenMethod lhs method = tell $ MockSpec lhs method
 
--- | @'throwNoStubShow' matcher@ means the method raises a runtime exception
+-- | @'throwNoStub' matcher@ means the method raises a runtime exception
 -- if the arguments matches @matcher@. The argument tuple is converted to 'String' by
 -- using 'show' function.
-throwNoStubShow ::
+throwNoStub ::
   ( Method method,
     Show (AsTuple (Args method)),
     TupleLike (Args method)
   ) =>
   Matcher (Args method) ->
   Mock method
-throwNoStubShow matcher =
-  tell $
-    MockSpec matcher $
-      curryMethod $
-        error . ("no stub found for argument: " <>) . show . toTuple
+throwNoStub = throwNoStubWithShow (show . toTuple)
 
--- | @'throwNoStubShow' fshow matcher@ means the method raises runtime exception
+-- | @'throwNoStubWithShow' fshow matcher@ means the method raises runtime exception
 -- if the arguments matches @matcher@. The argument tuple is converted to 'String' by
 -- using 'fshow' function.
-throwNoStub :: (Method method) => (Args method -> String) -> (Args method -> Bool) -> Mock method
-throwNoStub fshow matcher =
+throwNoStubWithShow :: (Method method) => (Args method -> String) -> (Args method -> Bool) -> Mock method
+throwNoStubWithShow fshow matcher =
   tell $
     MockSpec matcher $
       curryMethod $ error . ("no stub found for argument: " <>) . fshow
diff --git a/src/Test/Method/Protocol.hs b/src/Test/Method/Protocol.hs
new file mode 100644
--- /dev/null
+++ b/src/Test/Method/Protocol.hs
@@ -0,0 +1,246 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+
+-- |
+-- Module : Test.Method.Protocol
+-- Description:
+-- License: BSD-3
+-- Maintainer: autotaker@gmail.com
+-- Stability: experimental
+module Test.Method.Protocol
+  ( protocol,
+    ProtocolM,
+    ProtocolEnv,
+    Call,
+    CallArgs,
+    CallId,
+    IsMethodName,
+    lookupMock,
+    lookupMockWithShow,
+    decl,
+    whenArgs,
+    thenMethod,
+    thenAction,
+    thenReturn,
+    dependsOn,
+    verify,
+  )
+where
+
+import Control.Method
+  ( Method (Args, Base, curryMethod, uncurryMethod),
+    TupleLike (AsTuple, toTuple),
+  )
+import Control.Monad.Trans.State.Strict (StateT, execStateT, state)
+import Data.Maybe (fromJust)
+import Data.Typeable
+  ( Typeable,
+    cast,
+    typeOf,
+  )
+import RIO (IORef, MonadIO (liftIO), Set, forM_, newIORef, on, readIORef, unless, writeIORef, (&))
+import qualified RIO.List as L
+import qualified RIO.Map as M
+import qualified RIO.Set as S
+import Test.Method.Behavior (Behave (Condition, MethodOf, thenMethod), thenAction, thenReturn)
+import Test.Method.Matcher (ArgsMatcher (EachMatcher, args), Matcher)
+import Unsafe.Coerce (unsafeCoerce)
+
+newtype CallId = CallId {unCallId :: Int}
+  deriving (Eq, Ord, Show)
+
+data CallArgs f m = CallArgs
+  { methodName :: f m,
+    argsMatcher :: Matcher (Args m)
+  }
+
+data Call f m = Call
+  { argsSpec :: CallArgs f m,
+    retSpec :: m,
+    dependCall :: [CallId]
+  }
+
+data SomeCall f where
+  SomeCall :: IsMethodName f m => Call f m -> SomeCall f
+
+data SomeMethodName f where
+  SomeMethodName :: IsMethodName f m => f m -> SomeMethodName f
+
+instance Eq (SomeMethodName f) where
+  SomeMethodName x == SomeMethodName y =
+    case cast y of
+      Just y' -> x == y'
+      Nothing -> False
+
+instance Ord (SomeMethodName f) where
+  compare (SomeMethodName x) (SomeMethodName y) =
+    compare (typeOf x) (typeOf y) <> case cast y of
+      Just y' -> compare x y'
+      Nothing -> LT
+
+instance Show (SomeMethodName f) where
+  show (SomeMethodName x) = show x
+
+data MethodCallAssoc f where
+  MethodCallAssoc ::
+    forall f m.
+    (Typeable (f m), Show (f m)) =>
+    { assocCalls :: [(CallId, Call f m)],
+      assocCounter :: IORef Int
+    } ->
+    MethodCallAssoc f
+
+-- | @'ProtocolEnv' f@ provides mock methods, where @f@ is a GADT functor that
+--   represents the set of dependent methods.
+data ProtocolEnv f = ProtocolEnv
+  { callSpecs :: [(CallId, SomeCall f)],
+    methodEnv :: M.Map (SomeMethodName f) (MethodCallAssoc f),
+    calledIdSetRef :: IORef (Set CallId)
+  }
+
+newtype ProtocolM f a
+  = ProtocolM (StateT ([(CallId, SomeCall f)], CallId) IO a)
+
+deriving instance Functor (ProtocolM f)
+
+deriving instance Applicative (ProtocolM f)
+
+deriving instance Monad (ProtocolM f)
+
+getMethodName :: SomeCall f -> SomeMethodName f
+getMethodName (SomeCall Call {argsSpec = CallArgs {methodName = name}}) = SomeMethodName name
+
+-- | Build 'ProtocolEnv' from Protocol DSL.
+protocol :: ProtocolM f a -> IO (ProtocolEnv f)
+protocol (ProtocolM dsl) = do
+  (specs, _) <- execStateT dsl ([], CallId 0)
+  assocList <-
+    specs
+      & map (\(callId, call) -> (getMethodName call, callId, call))
+      & L.sortOn (\(x, y, _) -> (x, y))
+      & L.groupBy ((==) `on` (\(x, _, _) -> x))
+      & mapM
+        ( \l ->
+            case head l of
+              (SomeMethodName (name :: f m), _, _) -> do
+                ref <- newIORef 0
+                pure
+                  ( SomeMethodName name,
+                    MethodCallAssoc @f @m
+                      [(callId, unsafeCoerce call) | (_, callId, SomeCall call) <- l]
+                      ref
+                  )
+        )
+  ref <- newIORef S.empty
+  pure
+    ProtocolEnv
+      { callSpecs = specs,
+        methodEnv = M.fromList assocList,
+        calledIdSetRef = ref
+      }
+
+tick :: MonadIO m => IORef Int -> m Int
+tick ref = liftIO $ do
+  x <- readIORef ref
+  writeIORef ref (x + 1)
+  pure x
+
+type IsMethodName f m = (Typeable (f m), Ord (f m), Show (f m))
+
+-- | Get the mock method by method name.
+--   Return a unstubed method (which throws exception for every call)
+--   if the behavior of the method is unspecified by ProtocolEnv
+lookupMock ::
+  forall f m.
+  (IsMethodName f m, Show (AsTuple (Args m)), TupleLike (Args m), Method m, MonadIO (Base m)) =>
+  -- | name of method
+  f m ->
+  ProtocolEnv f ->
+  m
+lookupMock = lookupMockWithShow (show . toTuple)
+
+-- | Get the mock method by method name.
+--   Return a unstubed method (which throws exception for every call)
+--   if the behavior of the method is unspecified by ProtocolEnv.
+--   Use this function only if you want to customize
+--   show implementation for the argument of the method.
+lookupMockWithShow ::
+  forall f m.
+  (IsMethodName f m, Method m, MonadIO (Base m)) =>
+  -- | show function for the argument of method
+  (Args m -> String) ->
+  -- | name of method
+  f m ->
+  ProtocolEnv f ->
+  m
+lookupMockWithShow fshow name ProtocolEnv {..} =
+  case M.lookup (SomeMethodName name) methodEnv of
+    Nothing -> curryMethod $ \_ ->
+      error $
+        "0-th call of method " <> show name <> " is unspecified"
+    Just MethodCallAssoc {assocCalls = assocCalls', ..} ->
+      let assocCalls = unsafeCoerce assocCalls' :: [(CallId, Call f m)]
+       in curryMethod $ \xs -> do
+            i <- tick assocCounter
+            unless (i < length assocCalls) $
+              error $ show i <> "-th call of method " <> show name <> " is unspecified"
+            let (callId, Call {..}) = assocCalls !! i
+                CallArgs {..} = argsSpec
+            unless (argsMatcher xs) $
+              error $
+                "unexpected argument of " <> show i <> "-th call of method " <> show name <> ": "
+                  <> fshow xs
+            calledIdSet <- liftIO $ readIORef calledIdSetRef
+            forM_ dependCall $ \callId' -> do
+              unless (S.member callId' calledIdSet) $
+                let call = fromJust $ L.lookup callId' callSpecs
+                 in error $ "dependent method " <> show (getMethodName call) <> " is not called: " <> show callId'
+            liftIO $ writeIORef calledIdSetRef $! S.insert callId calledIdSet
+            uncurryMethod retSpec xs
+
+-- | Declare a method call specification. It returns the call id of the method call.
+decl :: (IsMethodName f m) => Call f m -> ProtocolM f CallId
+decl call = ProtocolM $
+  state $ \(l, callId@(CallId i)) ->
+    (callId, ((callId, SomeCall call) : l, CallId (i + 1)))
+
+-- | Specify the argument condition of a method call
+whenArgs :: ArgsMatcher (Args m) => f m -> EachMatcher (Args m) -> CallArgs f m
+whenArgs name matcher = CallArgs {methodName = name, argsMatcher = args matcher}
+
+instance Behave (Call f m) where
+  type Condition (Call f m) = CallArgs f m
+  type MethodOf (Call f m) = m
+  thenMethod lhs m =
+    Call
+      { argsSpec = lhs,
+        retSpec = m,
+        dependCall = []
+      }
+
+-- | Specify on which method calls the call depends.
+dependsOn :: Call f m -> [CallId] -> Call f m
+dependsOn call depends = call {dependCall = depends <> dependCall call}
+
+-- | Verify that all method calls specified by Protocol DSL are fired.
+verify :: ProtocolEnv f -> IO ()
+verify ProtocolEnv {..} = do
+  forM_ (M.assocs methodEnv) $ \(name, MethodCallAssoc {..}) -> do
+    n <- readIORef assocCounter
+    let expected = length assocCalls
+    unless (n == expected) $
+      error $
+        "method " <> show name <> " should be called " <> show expected
+          <> " times, but actually is called "
+          <> show n
+          <> " times"
diff --git a/test/Test/Method/DynamicSpec.hs b/test/Test/Method/DynamicSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Test/Method/DynamicSpec.hs
@@ -0,0 +1,78 @@
+{-# LANGUAGE TypeApplications #-}
+
+module Test.Method.DynamicSpec where
+
+import Control.Exception (evaluate)
+import Control.Exception.Base (ErrorCall (ErrorCall))
+import Data.Proxy (Proxy (Proxy), asProxyTypeOf)
+import Test.Hspec
+  ( Expectation,
+    Spec,
+    anyErrorCall,
+    describe,
+    it,
+    shouldBe,
+    shouldReturn,
+    shouldThrow,
+  )
+import Test.Method.Dynamic
+  ( Dynamic,
+    DynamicShow,
+    FromDyn (fromDyn),
+    ToDyn (toDyn),
+    Typeable,
+    castMethod,
+    dynArg,
+  )
+import Test.Method.Matcher
+  ( ArgsMatcher (args),
+    Matcher,
+    anything,
+    when,
+  )
+import Test.Method.Mock (mockup, thenReturn, throwNoStub)
+
+spec :: Spec
+spec = do
+  describe "fromDyn" $ do
+    let fid :: (FromDyn b a, ToDyn b a, Show a, Eq a) => Proxy b -> a -> Expectation
+        fid proxy x = fromDyn (toDyn x `asProxyTypeOf` proxy) `shouldBe` x
+    it "Int -> Int" $ fid (Proxy @Int) (0 :: Int)
+    it "Dynamic -> Int" $ fid (Proxy @Dynamic) (0 :: Int)
+    it "DynamicShow ->Int" $ fid (Proxy @DynamicShow) (0 :: Int)
+    it "[Dynamic] -> [Int]" $ fid (Proxy @[Dynamic]) [0 :: Int]
+    it "Maybe Dynamic -> Maybe ()" $ fid (Proxy @(Maybe Dynamic)) (Nothing :: Maybe ())
+    it "Either Dynamic Bool -> Either Int Bool" $ fid (Proxy @(Either Dynamic Bool)) (Left 0 :: Either Int Bool)
+    it "(Int, Dynamic) -> (Int, Int)" $ fid (Proxy @(Int, Dynamic)) (0 :: Int, 0 :: Int)
+    it "Dynamic^7 -> Char^7" $
+      fid
+        (Proxy @(Dynamic, Dynamic, Dynamic, Dynamic, Dynamic, Dynamic, Dynamic))
+        ('a', 'b', 'c', 'd', 'e', 'f', 'g')
+    it "((Int, Dynamic) -> (Dynamic, Int)) -> ((Int, Int) -> (Int, Int))" $ do
+      let f :: (Int, Int) -> (Int, Int)
+          f = fromDyn (toDyn (id :: (Int, Int) -> (Int, Int)) :: ((Int, Dynamic) -> (Dynamic, Int)))
+      f (42, 57) `shouldBe` (42, 57)
+
+    it "throw type error" $
+      evaluate (fromDyn (toDyn True :: Dynamic) :: Char)
+        `shouldThrow` ( \(ErrorCall msg) ->
+                          msg == "cannot cast <<Bool>> to Char"
+                      )
+
+  describe "Show DynamicShow" $ do
+    it "show (DynamicShow (0 :: Int)) == \"<<0 :: Int>>\"" $ do
+      show (toDyn (0 :: Int) :: DynamicShow) `shouldBe` "<<0 :: Int>>"
+  describe "castMethod" $ do
+    let f :: (Typeable a, Show a) => String -> a -> IO a
+        f = castMethod f'
+        f' :: String -> DynamicShow -> IO DynamicShow
+        f' = mockup $ do
+          when (args ((== "int"), dynArg (== (10 :: Int)))) `thenReturn` toDyn (20 :: Int)
+          when (args ((== "bool"), dynArg (== True))) `thenReturn` toDyn False
+          when (args ((== "invalid"), dynArg (anything :: Matcher Bool))) `thenReturn` toDyn 'A'
+          throwNoStub (when anything)
+    it "polymorphic" $ do
+      f "int" (10 :: Int) `shouldReturn` 20
+      f "bool" True `shouldReturn` False
+      (f "invalid" True >>= evaluate) `shouldThrow` anyErrorCall
+      f "invalid" 'a' `shouldThrow` anyErrorCall
diff --git a/test/Test/Method/ProtocolSpec.hs b/test/Test/Method/ProtocolSpec.hs
new file mode 100644
--- /dev/null
+++ b/test/Test/Method/ProtocolSpec.hs
@@ -0,0 +1,185 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE StandaloneDeriving #-}
+
+module Test.Method.ProtocolSpec where
+
+import RIO (ByteString, Text, void)
+import Test.Hspec
+  ( Spec,
+    anyErrorCall,
+    before,
+    context,
+    describe,
+    it,
+    shouldReturn,
+    shouldThrow,
+  )
+import Test.Method.Protocol
+  ( ProtocolM,
+    decl,
+    dependsOn,
+    lookupMock,
+    protocol,
+    thenReturn,
+    verify,
+    whenArgs,
+  )
+
+data Methods m where
+  FindUser :: Methods (UserName -> IO (Maybe User))
+  FindPassword :: Methods (UserName -> IO (Maybe HashedPassword))
+  CreateUser :: Methods (UserName -> IO User)
+  HashPassword :: Methods (PlainPassword -> IO HashedPassword)
+  UpsertAuth :: Methods (UserId -> HashedPassword -> IO ())
+
+data Service = Service
+  { findUser :: UserName -> IO (Maybe User),
+    findPassword :: UserName -> IO (Maybe HashedPassword),
+    createUser :: UserName -> IO User,
+    hashPassword :: PlainPassword -> IO HashedPassword,
+    upsertAuth :: UserId -> HashedPassword -> IO ()
+  }
+
+doService :: Service -> UserName -> PlainPassword -> IO (Maybe User)
+doService Service {..} usernm passwd = do
+  mUser <- findUser usernm
+  case mUser of
+    Just _ -> pure Nothing
+    Nothing -> do
+      hpasswd <- hashPassword passwd
+      user <- createUser usernm
+      upsertAuth (userId user) hpasswd
+      pure $ Just user
+
+doServiceHashFirst :: Service -> UserName -> PlainPassword -> IO (Maybe User)
+doServiceHashFirst Service {..} usernm passwd = do
+  hpasswd <- hashPassword passwd
+  mUser <- findUser usernm
+  case mUser of
+    Just _ -> pure Nothing
+    Nothing -> do
+      user <- createUser usernm
+      upsertAuth (userId user) hpasswd
+      pure $ Just user
+
+doServiceWrongArgument :: Service -> UserName -> PlainPassword -> IO (Maybe User)
+doServiceWrongArgument Service {..} usernm passwd = do
+  mUser <- findUser usernm
+  case mUser of
+    Just _ -> pure Nothing
+    Nothing -> do
+      _ <- hashPassword passwd
+      user <- createUser usernm
+      upsertAuth (userId user) passwd
+      pure $ Just user
+
+doServiceWrongExtraCalls :: Service -> UserName -> PlainPassword -> IO (Maybe User)
+doServiceWrongExtraCalls Service {..} usernm passwd = do
+  mUser <- findUser usernm
+  case mUser of
+    Just _ -> pure Nothing
+    Nothing -> do
+      hpasswd <- hashPassword passwd
+      hpasswd' <- hashPassword hpasswd
+      user <- createUser usernm
+      upsertAuth (userId user) hpasswd'
+      pure $ Just user
+
+doServiceWrongMissingCalls :: Service -> UserName -> PlainPassword -> IO (Maybe User)
+doServiceWrongMissingCalls Service {..} usernm passwd = do
+  mUser <- findUser usernm
+  case mUser of
+    Just _ -> pure Nothing
+    Nothing -> do
+      _ <- hashPassword passwd
+      user <- createUser usernm
+      pure $ Just user
+
+doServiceWrongOrder :: Service -> UserName -> PlainPassword -> IO (Maybe User)
+doServiceWrongOrder Service {..} usernm passwd = do
+  user <- createUser usernm
+  mUser <- findUser usernm
+  case mUser of
+    Just _ -> pure Nothing
+    Nothing -> do
+      hpasswd <- hashPassword passwd
+      upsertAuth (userId user) hpasswd
+      pure $ Just user
+
+doServiceWrongUnspecifiedMethod :: Service -> UserName -> PlainPassword -> IO (Maybe User)
+doServiceWrongUnspecifiedMethod Service {..} usernm _passwd = do
+  mUser <- findUser usernm
+  case mUser of
+    Just _ -> pure Nothing
+    Nothing -> do
+      Just hpasswd <- findPassword usernm
+      user <- createUser usernm
+      upsertAuth (userId user) hpasswd
+      pure $ Just user
+
+serviceProtocol :: UserName -> PlainPassword -> HashedPassword -> UserId -> ProtocolM Methods ()
+serviceProtocol usernm passwd hpasswd userid = do
+  i1 <- decl $ whenArgs FindUser (== usernm) `thenReturn` Nothing
+  i2 <- decl $ whenArgs CreateUser (== usernm) `thenReturn` User usernm userid `dependsOn` [i1]
+  i3 <- decl $ whenArgs HashPassword (== passwd) `thenReturn` hpasswd
+  void $ decl $ whenArgs UpsertAuth ((== userid), (== hpasswd)) `thenReturn` () `dependsOn` [i2, i3]
+
+deriving instance (Show (Methods m))
+
+deriving instance (Eq (Methods m))
+
+deriving instance (Ord (Methods m))
+
+type UserName = Text
+
+type PlainPassword = ByteString
+
+type HashedPassword = ByteString
+
+type UserId = Int
+
+data Env = Env
+
+data User = User {userName :: UserName, userId :: UserId}
+  deriving (Eq, Ord, Show)
+
+spec :: Spec
+spec = describe "protocol" $ do
+  let usernm = "user1"
+      passwd = "password1"
+      hpasswd = "hashed_password1"
+      userid = 0
+  let setup = do
+        penv <- protocol $ serviceProtocol usernm passwd hpasswd userid
+        pure
+          ( penv,
+            Service
+              { findUser = lookupMock FindUser penv,
+                findPassword = lookupMock FindPassword penv,
+                createUser = lookupMock CreateUser penv,
+                hashPassword = lookupMock HashPassword penv,
+                upsertAuth = lookupMock UpsertAuth penv
+              }
+          )
+  before setup $ do
+    context "accept valid impl" $ do
+      it "accept valid impl findUser first" $ \(penv, service) -> do
+        doService service usernm passwd `shouldReturn` Just (User usernm userid)
+        verify penv
+      it "accept valid impl hash first" $ \(penv, service) -> do
+        doServiceHashFirst service usernm passwd `shouldReturn` Just (User usernm userid)
+        verify penv
+    context "reject invalid impl" $ do
+      it "invalid argument" $ \(_, service) ->
+        doServiceWrongArgument service usernm passwd `shouldThrow` anyErrorCall
+      it "extra calls" $ \(_, service) ->
+        doServiceWrongExtraCalls service usernm passwd `shouldThrow` anyErrorCall
+      it "missing calls" $ \(penv, service) -> do
+        doServiceWrongMissingCalls service usernm passwd `shouldReturn` Just (User usernm userid)
+        verify penv `shouldThrow` anyErrorCall
+      it "wrong order" $ \(_, service) -> do
+        doServiceWrongOrder service usernm passwd `shouldThrow` anyErrorCall
+      it "unspecified method call" $ \(_, service) -> do
+        doServiceWrongUnspecifiedMethod service usernm passwd `shouldThrow` anyErrorCall