diff --git a/src/TypedSession/Core.hs b/src/TypedSession/Core.hs
--- a/src/TypedSession/Core.hs
+++ b/src/TypedSession/Core.hs
@@ -1,11 +1,13 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneKindSignatures #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
diff --git a/src/TypedSession/Driver.hs b/src/TypedSession/Driver.hs
--- a/src/TypedSession/Driver.hs
+++ b/src/TypedSession/Driver.hs
@@ -10,6 +10,7 @@
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-unused-do-bind #-}
+{-# LANGUAGE NumericUnderscores #-}
 
 {- |
 Schematic diagram of the communication structure of three roles through typed-session:
@@ -31,6 +32,7 @@
 
 import Control.Concurrent.Class.MonadSTM
 import Control.Monad.Class.MonadThrow (MonadThrow, throwIO)
+import Control.Monad.Class.MonadTimer (MonadDelay, threadDelay)
 import Data.IFunctor (At (..), Sing, SingI (sing))
 import qualified Data.IFunctor as I
 import Data.IntMap (IntMap)
@@ -196,7 +198,7 @@
 This usually happens when the efficiency of Msg generation is greater than the efficiency of consumption.
 -}
 decodeLoop
-  :: (Exception failure, MonadSTM n, MonadThrow n)
+  :: (Exception failure, MonadDelay n, MonadSTM n, MonadThrow n)
   => Tracer role' ps n
   -> Maybe bytes
   -> Decode role' ps failure bytes
@@ -214,4 +216,6 @@
           Nothing -> writeTVar tvar (IntMap.insert agencyInt (AnyMsg msg) agencyMsg)
           Just _v -> retry
       decodeLoop tracer mbt' d channel tvar
-    Left failure -> throwIO failure
+    Left failure -> do
+      threadDelay 1_000_000
+      throwIO failure
diff --git a/src/TypedSession/TH.hs b/src/TypedSession/TH.hs
--- a/src/TypedSession/TH.hs
+++ b/src/TypedSession/TH.hs
@@ -21,6 +21,7 @@
 import Data.IFunctor (Sing, SingI (..))
 import Data.Kind
 import qualified Data.Set as Set
+import Data.Traversable (for)
 import GHC.Exts (DataToTag (..), Int (..))
 import Language.Haskell.TH hiding (Type)
 import qualified Language.Haskell.TH as TH
@@ -77,7 +78,7 @@
     _ -> error $ "Name: " ++ show name ++ " is not a data constructor"
 
 protDecsAndMsgDecs :: forall r bst. (Show r, Show bst) => String -> Name -> Name -> PipeResult r bst -> Q [Dec]
-protDecsAndMsgDecs protN roleName bstName PipeResult{msgT1, dnySet, stBound = (fromVal, toVal), branchResultTypeInfo} = do
+protDecsAndMsgDecs protN roleName bstName PipeResult{msgT1, dnySet, stBound = (fromVal, toVal), branchResultTypeInfo, branchFunList} = do
   let protName = mkName protN
       protSName = mkName ("S" <> protN)
       mkSiName i = mkName $ "S" <> show i
@@ -109,6 +110,8 @@
           )
         | ag <- args
         ]
+      typeListT :: [TH.Type] -> TH.Type
+      typeListT = foldl1 AppT
 
   sVar <- newName "s"
   aVar <- newName "a"
@@ -150,6 +153,23 @@
         | (name, constrs) <- branchResultTypeInfo
         , let dataName = mkName name
         ]
+  branchFunTypes <- for branchFunList $ \(r, st, t) -> do
+    mVar <- newName "m"
+    pure
+      ( TySynD
+          (mkName (st <> "Fun"))
+          [KindedTV mVar BndrReq (AppT (AppT ArrowT StarT) StarT)]
+          ( typeListT
+              [ ConT ''TSC.Peer
+              , ConT roleName
+              , ConT protName
+              , ConT (mkName (show r))
+              , VarT mVar
+              , ConT (mkName st)
+              , (tAnyToType (mkName "s") t)
+              ]
+          )
+      )
 
   s1 <- newName "s1"
   -- generate instance SingI
@@ -197,10 +217,7 @@
         ]
     _ -> error $ "Name: " ++ show roleName ++ " is not a data constructor"
 
-  let typeListT :: [TH.Type] -> TH.Type
-      typeListT = foldl1 AppT
-
-      isTAny :: T bst -> Bool
+  let isTAny :: T bst -> Bool
       isTAny = \case
         TAny _ -> True
         _ -> False
@@ -276,6 +293,7 @@
       ++ dataSingletonProt
       ++ singSingletonProt
       ++ branchResultDatas
+      ++ branchFunTypes
       ++ instanceSingI
       ++ instanceSingToInt
       ++ instanceMsg
diff --git a/test/Book.hs b/test/Book.hs
--- a/test/Book.hs
+++ b/test/Book.hs
@@ -31,6 +31,7 @@
 import TypedSession.Codec
 import TypedSession.Core
 import TypedSession.Driver
+import Control.Monad.Class.MonadTimer (MonadDelay)
 
 {-
 
@@ -205,7 +206,7 @@
     Date i -> "Date " <> show i
     NotBuy -> "NotBuy"
 
-runAll :: forall m. (Monad m, MonadSTM m, MonadSay m, MonadFork m, MonadThrow m) => m ()
+runAll :: forall m. (Monad m, MonadDelay m, MonadSTM m, MonadSay m, MonadFork m, MonadThrow m) => m ()
 runAll = do
   buyerTMVar <- newEmptyTMVarIO @m @(AnyMsg Role BookSt)
   sellerTMVar <- newEmptyTMVarIO @m @(AnyMsg Role BookSt)
diff --git a/test/Book1.hs b/test/Book1.hs
--- a/test/Book1.hs
+++ b/test/Book1.hs
@@ -31,6 +31,7 @@
 import TypedSession.Codec
 import TypedSession.Core
 import TypedSession.Driver
+import Control.Monad.Class.MonadTimer (MonadDelay)
 
 {-
 
@@ -235,7 +236,7 @@
     Date i -> "Date " <> show i
     NotBuy -> "NotBuy"
 
-runAll :: forall m. (Monad m, MonadSTM m, MonadSay m, MonadFork m, MonadThrow m) => m ()
+runAll :: forall m. (Monad m, MonadDelay m, MonadSTM m, MonadSay m, MonadFork m, MonadThrow m) => m ()
 runAll = do
   buyerTMVar <- newEmptyTMVarIO @m @(AnyMsg Role BookSt)
   buyer2TMVar <- newEmptyTMVarIO @m @(AnyMsg Role BookSt)
diff --git a/test/Book2.hs b/test/Book2.hs
--- a/test/Book2.hs
+++ b/test/Book2.hs
@@ -22,6 +22,7 @@
 import Control.Monad.Class.MonadFork (MonadFork, forkIO)
 import Control.Monad.Class.MonadSay
 import Control.Monad.Class.MonadThrow (MonadThrow)
+import Control.Monad.Class.MonadTimer (MonadDelay)
 import Data.IFunctor (At (..), Sing, SingI, ireturn, returnAt)
 import qualified Data.IFunctor as I
 import qualified Data.IntMap as IntMap
@@ -296,7 +297,7 @@
     BookNotFoun -> "BookNotFound"
     SellerNotFoundBook -> "SellerNotFoundBook"
 
-runAll :: forall m. (Monad m, MonadSTM m, MonadSay m, MonadFork m, MonadThrow m) => m ()
+runAll :: forall m. (Monad m, MonadDelay m, MonadSTM m, MonadSay m, MonadFork m, MonadThrow m) => m ()
 runAll = do
   buyerTMVar <- newEmptyTMVarIO @m @(AnyMsg Role BookSt)
   buyer2TMVar <- newEmptyTMVarIO @m @(AnyMsg Role BookSt)
diff --git a/test/Book3/Main.hs b/test/Book3/Main.hs
--- a/test/Book3/Main.hs
+++ b/test/Book3/Main.hs
@@ -31,6 +31,7 @@
 import TypedSession.Codec
 import TypedSession.Core
 import TypedSession.Driver
+import Control.Monad.Class.MonadTimer (MonadDelay)
 
 mvarsAsChannel
   :: (MonadSTM m)
@@ -53,6 +54,7 @@
      , MonadSay n
      , MonadThrow n
      , MonadFork n
+     , MonadDelay n
      )
   => StdGen
   -> n ()
diff --git a/test/Book3/Peer.hs b/test/Book3/Peer.hs
--- a/test/Book3/Peer.hs
+++ b/test/Book3/Peer.hs
@@ -32,7 +32,7 @@
   :: (Has Random sig m)
   => Int
   -> Int
-  -> Peer BookRole Book Buyer m EnoughOrNotEnough S8
+  -> EnoughOrNotEnoughFun m
 checkPrice _i _h = I.do
   At b <- liftm $ uniform @Bool
   if b
@@ -42,7 +42,7 @@
 choiceOT
   :: (Has Random sig m)
   => Int
-  -> Peer BookRole Book Buyer m OneOrTwo S4
+  -> OneOrTwoFun m
 choiceOT _i = I.do
   At b <- liftm $ uniform @Bool
   if b
@@ -91,7 +91,7 @@
 choiceB
   :: (Has Random sig m)
   => Int
-  -> Peer BookRole Book Buyer2 m SupportOrNotSupport S7
+  -> SupportOrNotSupportFun m
 choiceB _i = I.do
   At b <- liftm $ uniform @Bool
   if b
@@ -119,7 +119,7 @@
 findBook
   :: (Has Random sig m)
   => String
-  -> Peer BookRole Book Seller m FindBookResult S3
+  -> FindBookResultFun m
 findBook _st = I.do
   At b <- liftm $ uniform @Bool
   if b
diff --git a/test/Book3/Protocol.hs b/test/Book3/Protocol.hs
--- a/test/Book3/Protocol.hs
+++ b/test/Book3/Protocol.hs
@@ -17,6 +17,7 @@
 
 import Book3.Type
 
+import Language.Haskell.TH hiding (Type)
 import TypedSession.Codec
 import TypedSession.Core
 
diff --git a/test/PingPong.hs b/test/PingPong.hs
--- a/test/PingPong.hs
+++ b/test/PingPong.hs
@@ -22,6 +22,7 @@
 import Control.Monad.Class.MonadFork (MonadFork, forkIO)
 import Control.Monad.Class.MonadSay
 import Control.Monad.Class.MonadThrow (MonadThrow)
+import Control.Monad.Class.MonadTimer (MonadDelay)
 import Data.IFunctor (At (..), Sing, SingI, ireturn, returnAt)
 import qualified Data.IFunctor as I
 import qualified Data.IntMap as IntMap
@@ -169,7 +170,7 @@
     Pong i -> "Pong " <> show i
     Stop -> "Stop"
 
-runAll :: forall m. (Monad m, MonadSTM m, MonadSay m, MonadFork m, MonadThrow m) => m ()
+runAll :: forall m. (Monad m, MonadDelay m, MonadSTM m, MonadSay m, MonadFork m, MonadThrow m) => m ()
 runAll = do
   clientTMVar <- newEmptyTMVarIO @m @(AnyMsg Role PingPong)
   serverTMVar <- newEmptyTMVarIO @m @(AnyMsg Role PingPong)
diff --git a/typed-session.cabal b/typed-session.cabal
--- a/typed-session.cabal
+++ b/typed-session.cabal
@@ -20,7 +20,7 @@
 -- PVP summary:     +-+------- breaking API changes
 --                  | | +----- non-breaking API additions
 --                  | | | +--- code changes with no API change
-version:            0.1.2.0
+version:            0.1.3.0
 
 -- A short (one-line) description of the package.
 synopsis: typed session framework