Generalized Network.DatagramServer

8 files changed, 414 insertions, 368 deletions

diff --git a/src/Network/BitTorrent/DHT/Query.hs b/src/Network/BitTorrent/DHT/Query.hs
index fc6625ae..9adad163 100644
--- a/src/Network/BitTorrent/DHT/Query.hs
+++ b/src/Network/BitTorrent/DHT/Query.hs
@@ -82,6 +82,7 @@ import Data.Time
 import Data.Time.Clock.POSIX
 
 import Network.DatagramServer as KRPC hiding (Options, def)
+import Network.KRPC.Method    as KRPC
 import Network.DatagramServer.Mainline (ReflectedIP(..))
 import Network.DatagramServer (QueryFailure(..))
 import Data.Torrent
@@ -112,8 +113,8 @@ nodeHandler :: ( Address ip
 #else
                , KPRC.Envelope (Query a) (Response b) ~ ByteString )
 #endif
-           => (NodeAddr ip -> a -> DHT ip b) -> NodeHandler ip
-nodeHandler action = handler $ \ sockAddr qry -> do
+           => QueryMethod KMessageOf -> (NodeAddr ip -> a -> DHT ip b) -> NodeHandler ip
+nodeHandler method action = handler method $ \ sockAddr qry -> do
 #ifdef VERSION_bencoding
   let remoteId  = queringNodeId qry
       read_only = queryIsReadOnly qry
@@ -138,27 +139,27 @@ nodeHandler action = handler $ \ sockAddr qry -> do
 -- | Default 'Ping' handler.
 pingH :: Address ip => NodeHandler ip
 #ifdef VERSION_bencoding
-pingH = nodeHandler $ \ _ Ping -> return Ping
+pingH = nodeHandler "ping" $ \ _ Ping -> return Ping
 #else
 pingH = nodeHandler $ \ _ p@PingPayload{} -> return p { isPong = True }
 #endif
 
 -- | Default 'FindNode' handler.
 findNodeH :: Address ip => NodeHandler ip
-findNodeH = nodeHandler $ \ _ (FindNode nid) -> do
+findNodeH = nodeHandler "find-nodes" $ \ _ (FindNode nid) -> do
   NodeFound <$> getClosest nid
 
 #ifdef VERSION_bencoding
 -- | Default 'GetPeers' handler.
 getPeersH :: Ord ip => Address ip => NodeHandler ip
-getPeersH = nodeHandler $ \ naddr (GetPeers ih) -> do
+getPeersH = nodeHandler "get_peers" $ \ naddr (GetPeers ih) -> do
   ps <- getPeerList ih
   tok <- grantToken naddr
   return $ GotPeers ps tok
 
 -- | Default 'Announce' handler.
 announceH :: Ord ip => Address ip => NodeHandler ip
-announceH = nodeHandler $ \ naddr @ NodeAddr {..} (Announce {..}) -> do
+announceH = nodeHandler "announce_peer" $ \ naddr @ NodeAddr {..} (Announce {..}) -> do
   valid <- checkToken naddr sessionToken
   unless valid $ do
     throwIO $ InvalidParameter "token"
@@ -396,7 +397,8 @@ queryNode' :: forall a b ip. Address ip => KRPC (Query a) (Response b)
 queryNode' addr q = do
   nid <- myNodeIdAccordingTo addr
   let read_only = False -- TODO: check for NAT issues. (BEP 43)
-  (Response remoteId r, witnessed_ip) <- query' (toSockAddr addr) (Query nid read_only q)
+  let KRPC.Method name = KRPC.method :: KRPC.Method (Query a) (Response b)
+  (Response remoteId r, witnessed_ip) <- query' name (toSockAddr addr) (Query nid read_only q)
   -- $(logDebugS) "queryNode" $ "Witnessed address: " <> T.pack (show witnessed_ip)
   --                             <> " by " <> T.pack (show (toSockAddr addr))
   _ <- insertNode (NodeInfo remoteId addr ()) witnessed_ip
diff --git a/src/Network/BitTorrent/DHT/Session.hs b/src/Network/BitTorrent/DHT/Session.hs
index f874b62e..0c819620 100644
--- a/src/Network/BitTorrent/DHT/Session.hs
+++ b/src/Network/BitTorrent/DHT/Session.hs
@@ -85,6 +85,7 @@ import Control.Monad.Logger
 import Control.Monad.Reader
 import Control.Monad.Trans.Control
 import Control.Monad.Trans.Resource
+import Data.Typeable
 import Data.ByteString
 import Data.Conduit.Lazy
 import Data.Default
@@ -266,10 +267,11 @@ data Node ip = Node
 #endif
 
   , resources     :: !InternalState
-  , manager       :: !(Manager (DHT       ip     )) -- ^ RPC manager;
 #ifdef VERSION_bencoding
+  , manager       :: !(Manager (DHT ip) BValue KMessageOf) -- ^ RPC manager;
   , routingInfo   :: !(TVar    (Maybe (R.Info KMessageOf ip ()))) -- ^ search table;
 #else
+  , manager       :: !(Manager (DHT ip) ByteString Tox.Message) -- ^ RPC manager;
   , routingInfo   :: !(TVar    (Maybe (R.Info Tox.Message ip Bool))) -- ^ search table;
 #endif
   , contactInfo   :: !(TVar    (PeerStore ip     )) -- ^ published by other nodes;
@@ -318,7 +320,7 @@ instance MonadResource (DHT ip) where
     s <- asks resources
     liftIO $ runInternalState m s
 
-instance MonadKRPC (DHT ip) (DHT ip) where
+instance MonadKRPC (DHT ip) (DHT ip) BValue KMessageOf where
   getManager = asks manager
 
 instance MonadLogger (DHT ip) where
@@ -364,7 +366,7 @@ newNode hs opts naddr logger mbid = do
                 <*> newTVarIO S.empty
                 <*> (newTVarIO =<< nullSessionTokens)
                 <*> pure logger
-        runReaderT (unDHT KRPC.listen) node
+        runReaderT (unDHT $ KRPC.listen (KRPC.Protocol Proxy Proxy)) node
         return node
 
 -- | Some resources like listener thread may live for
diff --git a/src/Network/DHT/Mainline.hs b/src/Network/DHT/Mainline.hs
index 7b3d6d55..2ecb9845 100644
--- a/src/Network/DHT/Mainline.hs
+++ b/src/Network/DHT/Mainline.hs
@@ -24,46 +24,12 @@ import Data.LargeWord
 import Data.Serialize                  as S
 import Data.String
 import Data.Typeable
+import Network.DatagramServer.Mainline (NodeId(..))
 import Network.DatagramServer.Mainline            as KRPC
 import Network.DatagramServer.Types as RPC
 import Text.PrettyPrint                as PP hiding ((<>))
 import Text.PrettyPrint.HughesPJClass  hiding (($$), (<>))
 
-nodeIdSize = finiteBitSize (undefined :: NodeId KMessageOf) `div` 8
-
-instance BEncode (NodeId KMessageOf) where
-    toBEncode (NodeId w) = toBEncode $ S.encode w
-    fromBEncode bval = fromBEncode bval >>= S.decode
-
--- instance BEncode NodeId where TODO
-
--- TODO: put this somewhere appropriate
-instance (Serialize a, Serialize b) => Serialize (LargeKey a b) where
-   put (LargeKey lo hi) = put hi >> put lo
-   get = flip LargeKey <$> get <*> get
-
-instance Serialize (NodeId KMessageOf) where
-  get = NodeId <$> get
-  {-# INLINE get #-}
-  put (NodeId bs) = put bs
-  {-# INLINE put #-}
-
--- | ASCII encoded.
-instance IsString (NodeId KMessageOf) where
-  fromString str
-    | length str == nodeIdSize     = NodeId (either error id $ S.decode (fromString str :: ByteString))
-    | length str == 2 * nodeIdSize = NodeId (either error id $ S.decode (fst $ Base16.decode $ fromString str))
-    |           otherwise = error "fromString: invalid NodeId length"
-  {-# INLINE fromString #-}
-
--- | Meaningless node id, for testing purposes only.
-instance Default (NodeId KMessageOf) where
-  def = NodeId 0
-
--- | base16 encoded.
-instance Pretty (NodeId KMessageOf) where
-  pPrint (NodeId nid) = PP.text $ Char8.unpack $ Base16.encode $ S.encode nid
-
 -- | KRPC 'compact list' compatible encoding: contact information for
 -- nodes is encoded as a 26-byte string. Also known as "Compact node
 -- info" the 20-byte Node ID in network byte order has the compact
@@ -115,38 +81,3 @@ bep42 addr (NodeId r)
 
 
 
-instance Envelope KMessageOf where
-    type TransactionID KMessageOf = KRPC.TransactionId
-
-    -- | Each node has a globally unique identifier known as the \"node
-    -- ID.\"
-    --
-    --   Normally, /this/ node id should be saved between invocations
-    --   of the client software.
-    newtype NodeId KMessageOf = NodeId Word160
-      deriving (Show, Eq, Ord, Typeable, Bits, FiniteBits)
-
-    envelopePayload (Q q) = queryArgs q
-    envelopePayload (R r) = respVals r
-    envelopePayload (E _) = error "TODO: messagePayload for KError"
-
-    envelopeTransaction (Q q) = queryId q
-    envelopeTransaction (R r) = respId r
-    envelopeTransaction (E e) = errorId e
-
-    envelopeClass (Q _) = Query
-    envelopeClass (R _) = Response
-    envelopeClass (E _) = Error
-
-    buildReply self addr qry response =
-        (R (KResponse response (envelopeTransaction qry) (Just $ ReflectedIP addr)))
-
-instance WireFormat BValue KMessageOf where
-    type SerializableTo BValue = BEncode
-    type CipherContext BValue KMessageOf = ()
-
-    decodeHeaders _ bs = BE.decode bs >>= BE.fromBEncode
-    decodePayload kmsg = mapM BE.fromBEncode kmsg
-
-    encodeHeaders _ kmsg = L.toStrict $ BE.encode kmsg
-    encodePayload msg = fmap BE.toBEncode msg
diff --git a/src/Network/DatagramServer.hs b/src/Network/DatagramServer.hs
index 21300108..e1bf91c5 100644
--- a/src/Network/DatagramServer.hs
+++ b/src/Network/DatagramServer.hs
@@ -60,6 +60,7 @@
 {-# LANGUAGE FunctionalDependencies #-}
 {-# LANGUAGE DeriveDataTypeable     #-}
 {-# LANGUAGE TemplateHaskell        #-}
+{-# LANGUAGE KindSignatures #-}
 module Network.DatagramServer
        ( -- * Methods
          Method
@@ -88,6 +89,7 @@ module Network.DatagramServer
        , withManager
        , isActive
        , listen
+       , Protocol(..)
 
          -- * Re-exports
        , ErrorCode (..)
@@ -96,7 +98,6 @@ module Network.DatagramServer
 
 import Data.Default.Class
 import Network.DatagramServer.Mainline
-import Network.KRPC.Method
 import Network.Socket (SockAddr (..))
 
 import Control.Applicative
@@ -192,42 +193,38 @@ validateOptions Options {..}
 --  Options
 -----------------------------------------------------------------------}
 
-type KResult = Either KError KMessage -- Response
+type KResult msg raw = Either (KError (TransactionID msg)) (msg raw)-- Response
 
 type TransactionCounter = IORef Int
-type CallId             = (TransactionId, SockAddr)
-type CallRes            = MVar (KQueryArgs, KResult) -- (raw response, decoded response)
-type PendingCalls       = IORef (Map CallId CallRes)
+type CallId msg           = (TransactionID msg, SockAddr)
+type CallRes msg raw      = MVar (raw, KResult msg raw) -- (raw response, decoded response)
+type PendingCalls msg raw = IORef (Map (CallId msg) (CallRes msg raw))
 
 type HandlerBody h msg v = SockAddr -> msg v -> h (Either String (msg v))
 
 -- | Handler is a function which will be invoked then some /remote/
 -- node querying /this/ node.
-type Handler     h msg v = (MethodName, HandlerBody h msg v)
+type Handler     h msg v = (QueryMethod msg, HandlerBody h msg v)
 
 -- | Keep track pending queries made by /this/ node and handle queries
 -- made by /remote/ nodes.
-data Manager h = Manager
+data Manager h raw msg = Manager
   { sock               :: !Socket
   , options            :: !Options
   , listenerThread     :: !(MVar ThreadId)
   , transactionCounter :: {-# UNPACK #-} !TransactionCounter
-  , pendingCalls       :: {-# UNPACK #-} !PendingCalls
-#ifdef VERSION_bencoding
-  , handlers           :: [Handler h KMessageOf BValue]
-#else
-  , handlers           :: [Handler h KMessageOf BC.ByteString]
-#endif
+  , pendingCalls       :: {-# UNPACK #-} !(PendingCalls msg raw)
+  , handlers           :: [Handler h msg raw]
   }
 
 -- | A monad which can perform or handle queries.
 class (MonadBaseControl IO m, MonadLogger m, MonadIO m)
-    => MonadKRPC h m | m -> h where
+    => MonadKRPC h m raw msg | m -> h, m -> raw, m -> msg  where
 
   -- | Ask for manager.
-  getManager :: m (Manager h)
+  getManager :: m (Manager h raw msg)
 
-  default getManager :: MonadReader (Manager h) m => m (Manager h)
+  default getManager :: MonadReader (Manager h raw msg) m => m (Manager h raw msg)
   getManager = ask
 
   -- | Can be used to add logging for instance.
@@ -237,7 +234,7 @@ class (MonadBaseControl IO m, MonadLogger m, MonadIO m)
   liftHandler = id
 
 instance (MonadBaseControl IO h, MonadLogger h, MonadIO h)
-      => MonadKRPC h (ReaderT (Manager h) h) where
+      => MonadKRPC h (ReaderT (Manager h raw msg) h) raw msg where
 
   liftHandler = lift
 
@@ -251,12 +248,8 @@ sockAddrFamily (SockAddrCan _        ) = AF_CAN
 -- run 'listen'.
 newManager :: Options                       -- ^ various protocol options;
            -> SockAddr                      -- ^ address to listen on;
-#ifdef VERSION_bencoding
-           -> [Handler h KMessageOf BValue] -- ^ handlers to run on incoming queries.
-#else
-           -> [Handler h KMessageOf BC.ByteString] -- ^ handlers to run on incoming queries.
-#endif
-           -> IO (Manager h)                -- ^ new rpc manager.
+           -> [Handler h msg raw] -- ^ handlers to run on incoming queries.
+           -> IO (Manager h raw msg)                -- ^ new rpc manager.
 newManager opts @ Options {..} servAddr handlers = do
     validateOptions opts
     sock  <- bindServ
@@ -274,7 +267,7 @@ newManager opts @ Options {..} servAddr handlers = do
       return sock
 
 -- | Unblock all pending calls and close socket.
-closeManager :: Manager m -> IO ()
+closeManager :: Manager m raw msg -> IO ()
 closeManager Manager {..} = do
   maybe (return ()) killThread =<< tryTakeMVar listenerThread
   -- TODO unblock calls
@@ -282,18 +275,14 @@ closeManager Manager {..} = do
 
 -- | Check if the manager is still active. Manager becomes active
 -- until 'closeManager' called.
-isActive :: Manager m -> IO Bool
+isActive :: Manager m raw msg -> IO Bool
 isActive Manager {..} = liftIO $ isBound sock
 {-# INLINE isActive #-}
 
 -- | Normally you should use Control.Monad.Trans.Resource.allocate
 -- function.
-#ifdef VERSION_bencoding
-withManager :: Options -> SockAddr -> [Handler h KMessageOf BValue]
-#else
-withManager :: Options -> SockAddr -> [Handler h KMessageOf BC.ByteString]
-#endif
-            -> (Manager h -> IO a) -> IO a
+withManager :: Options -> SockAddr -> [Handler h msg raw]
+            -> (Manager h raw msg -> IO a) -> IO a
 withManager opts addr hs = bracket (newManager opts addr hs) closeManager
 
 {-----------------------------------------------------------------------
@@ -301,15 +290,12 @@ withManager opts addr hs = bracket (newManager opts addr hs) closeManager
 -----------------------------------------------------------------------}
 
 -- TODO prettify log messages
-querySignature :: MethodName -> TransactionId -> SockAddr -> Text
+querySignature :: ( Show      ( QueryMethod   msg )
+                  , Serialize ( TransactionID msg ) )
+                  => QueryMethod msg -> TransactionID msg -> SockAddr -> Text
 querySignature name transaction addr = T.concat
-#ifdef VERSION_bencoding
-  [  "&", T.decodeUtf8 name
-  , " #", T.decodeUtf8 (Base16.encode transaction) -- T.decodeUtf8 transaction
-#else
   [  "&", T.pack (show name)
   , " #", T.decodeUtf8 (Base16.encode $ S.encode transaction)
-#endif
   , " @", T.pack (show addr)
   ]
 
@@ -332,23 +318,19 @@ sendMessage :: MonadIO m => Socket -> SockAddr -> BC.ByteString -> m ()
 sendMessage sock addr a = do
   liftIO $ sendManyTo sock [a] addr
 
-genTransactionId :: TransactionCounter -> IO TransactionId
+genTransactionId :: Envelope msg => TransactionCounter -> IO (TransactionID msg)
 genTransactionId ref = do
   cur <- atomicModifyIORef' ref $ \ cur -> (succ cur, cur)
-#ifdef VERSION_bencoding
-  return $ BC.pack (show cur)
-#else
-  return $ either (error "failed to create TransactionId") id $ S.decode $ BC.pack (L.take 24 $ show cur ++ L.repeat ' ')
-#endif
+  uniqueTransactionId cur
 
 -- | How many times 'query' call have been performed.
-getQueryCount :: MonadKRPC h m => m Int
+getQueryCount :: MonadKRPC h m raw msg => m Int
 getQueryCount = do
   Manager {..} <- getManager
   curTrans <- liftIO $ readIORef transactionCounter
   return $ curTrans - optSeedTransaction options
 
-registerQuery :: CallId -> PendingCalls -> IO CallRes
+registerQuery :: Ord (TransactionID msg) => CallId msg -> PendingCalls msg raw -> IO (CallRes msg raw)
 registerQuery cid ref = do
   ares <- newEmptyMVar
   atomicModifyIORef' ref $ \ m -> (M.insert cid ares m, ())
@@ -356,7 +338,7 @@ registerQuery cid ref = do
 
 -- simultaneous M.lookup and M.delete guarantees that we never get two
 -- or more responses to the same query
-unregisterQuery :: CallId -> PendingCalls -> IO (Maybe CallRes)
+unregisterQuery :: Ord (TransactionID msg) => CallId msg -> PendingCalls msg raw -> IO (Maybe (CallRes msg raw))
 unregisterQuery cid ref = do
   atomicModifyIORef' ref $ swap .
     M.updateLookupWithKey (const (const Nothing)) cid
@@ -374,35 +356,37 @@ sendQuery sock addr q = handle sockError $ sendMessage sock addr q
 --  This function should throw 'QueryFailure' exception if quered node
 --  respond with @error@ message or the query timeout expires.
 --
-query :: forall h m a b. (MonadKRPC h m, KRPC a b) => SockAddr -> a -> m b
-query addr params = queryK addr params (\_ x _ -> x)
+query :: forall h m a b raw msg. (SerializableTo raw b, Show (QueryMethod msg), Ord (TransactionID msg), Serialize (TransactionID msg), SerializableTo raw a, MonadKRPC h m raw msg, WireFormat raw msg, KRPC a b) => QueryMethod msg -> SockAddr -> a -> m b
+query meth addr params = queryK meth addr params (\_ x _ -> x)
 
 -- | Like 'query' but possibly returns your externally routable IP address.
-query' :: forall h m a b. (MonadKRPC h m, KRPC a b) => SockAddr -> a -> m (b, Maybe ReflectedIP)
-query' addr params = queryK addr params (const (,))
+query' :: forall h m a b raw msg. (SerializableTo raw b, Show (QueryMethod msg), Ord (TransactionID msg), Serialize (TransactionID msg), SerializableTo raw a, MonadKRPC h m raw msg, WireFormat raw msg, KRPC a b) => QueryMethod msg -> SockAddr -> a -> m (b, Maybe ReflectedIP)
+query' meth addr params = queryK meth addr params (const (,))
 
 -- | Enqueue a query, but give us the complete BEncoded content sent by the
 -- remote Node.  This is useful for handling extensions that this library does
 -- not otherwise support.
-queryRaw :: forall h m a b. (MonadKRPC h m, KRPC a b) => SockAddr -> a -> m (b, KQueryArgs)
-queryRaw addr params = queryK addr params (\raw x _ -> (x,raw))
+queryRaw :: forall h m a b raw msg. (SerializableTo raw b, Show (QueryMethod msg), Ord (TransactionID msg), Serialize (TransactionID msg), SerializableTo raw a, MonadKRPC h m raw msg, WireFormat raw msg, KRPC a b) => QueryMethod msg -> SockAddr -> a -> m (b, raw)
+queryRaw meth addr params = queryK meth addr params (\raw x _ -> (x,raw))
 
-queryK :: forall h m a b x. (MonadKRPC h m, KRPC a b) =>
-    SockAddr -> a -> (KQueryArgs -> b -> Maybe ReflectedIP -> x) -> m x
-queryK addr params kont = do
+queryK :: forall h m a b x raw msg. (SerializableTo raw b, Show (QueryMethod msg), Ord (TransactionID msg), Serialize (TransactionID msg), SerializableTo raw a, MonadKRPC h m raw msg, WireFormat raw msg, KRPC a b) =>
+    QueryMethod msg -> SockAddr -> a -> (raw -> b -> Maybe ReflectedIP -> x) -> m x
+queryK meth addr params kont = do
   Manager {..} <- getManager
   tid <- liftIO $ genTransactionId transactionCounter
-  let queryMethod = method :: Method a b
-  let signature = querySignature (methodName queryMethod) tid addr
+  -- let queryMethod = method :: Method a b
+  let signature = querySignature meth tid addr
   $(logDebugS) "query.sending" signature
 
   mres <- liftIO $ do
     ares <- registerQuery (tid, addr) pendingCalls
 
+    let cli = error "TODO TOX client node id"
+        ctx = error "TODO TOX ToxCipherContext or () for Mainline"
+    q <- buildQuery cli addr meth tid params
+    let qb = encodePayload (q :: msg a) :: msg raw
+        qbs = encodeHeaders ctx qb
 #ifdef VERSION_bencoding
-    let q = Q (KQuery (toBEncode params) (methodName queryMethod) tid)
-        qb = encodePayload q :: KMessage
-        qbs = encodeHeaders () qb :: BC.ByteString
 #else
     let q = Tox.Message (methodName queryMethod) cli tid params
         cli = error "TODO TOX client node id"
@@ -416,18 +400,13 @@ queryK addr params kont = do
     timeout (optQueryTimeout options * 10 ^ (6 :: Int)) $ do
       (raw,res) <- readMVar ares -- MVar (KQueryArgs, KResult)
       case res of
-#ifdef VERSION_bencoding
         Left  (KError   c m _) -> throwIO $ QueryFailed c (T.decodeUtf8 m)
-        Right (R (KResponse {..})) ->
-          case fromBEncode respVals of
-            Right r -> pure $ kont raw r respIP
-#else
-        Left  _                  -> throwIO $ QueryFailed GenericError "TODO: TOX ERROR"
-        Right (Tox.Message {..}) ->
-          case S.decode msgPayload of
-            Right r -> pure $ kont raw r Nothing
-#endif
-            Left  e -> throwIO $ QueryFailed ProtocolError (T.pack e)
+        Right m -> case decodePayload m of
+                    Right r -> case envelopeClass (r :: msg b) of
+                                Response reflectedAddr -> pure $ kont raw (envelopePayload r) reflectedAddr
+                                Error (KError   c m _) -> throwIO $ QueryFailed c (T.decodeUtf8 m) -- XXX neccessary?
+                                Query _                -> throwIO $ QueryFailed ProtocolError "BUG!! UNREACHABLE"
+                    Left e  -> throwIO $ QueryFailed ProtocolError (T.pack e)
 
   case mres of
     Just res -> do
@@ -477,43 +456,33 @@ prettyQF e = T.encodeUtf8 $ "handler fail while performing query: "
 --   If the handler make some 'query' normally it /should/ handle
 --   corresponding 'QueryFailure's.
 --
-handler :: forall h a b msg raw. (KRPC a b, Applicative h, Functor msg, WireFormat raw msg, SerializableTo raw a, SerializableTo raw b)
-        => (SockAddr -> a -> h b) -> Handler h msg raw
-handler body = (name, wrapper)
+handler :: forall h a b msg raw. (Applicative h, Functor msg, WireFormat raw msg, SerializableTo raw a, SerializableTo raw b)
+        => QueryMethod msg -> (SockAddr -> a -> h b) -> Handler h msg raw
+handler name body = (name, wrapper)
   where
-    Method name = method :: Method a b
     wrapper :: SockAddr -> msg raw -> h (Either String (msg raw))
     wrapper addr args =
       case decodePayload args of
         Left  e -> pure $ Left e
         Right a -> Right . encodePayload . buildReply (error "self node-id") addr args <$> body addr (envelopePayload a)
 
-runHandler :: MonadKRPC h m
-#ifdef VERSION_bencoding
-           => HandlerBody h KMessageOf BValue -> SockAddr -> KQuery -> m KResult
-#else
-           => HandlerBody h KMessageOf BC.ByteString -> SockAddr -> KQuery -> m KResult
-#endif
-runHandler h addr m = Lifted.catches wrapper failbacks
+runHandler :: ( MonadKRPC h m raw msg
+              , Envelope msg
+              , Show (QueryMethod msg)
+              , Serialize (TransactionID msg))
+           => QueryMethod msg -> HandlerBody h msg raw -> SockAddr -> msg raw -> m (KResult msg raw)
+runHandler meth h addr m = Lifted.catches wrapper failbacks
   where
-    signature = querySignature (queryMethod m) (queryId m) addr
+    signature = querySignature meth (envelopeTransaction m) addr
 
     wrapper = do
       $(logDebugS) "handler.quered" signature
-#ifdef VERSION_bencoding
-      result <- liftHandler (h addr (Q m))
-#else
       result <- liftHandler (h addr m)
-#endif
 
       case result of
         Left msg -> do
           $(logDebugS) "handler.bad_query" $ signature <> " !" <> T.pack msg
-#ifdef VERSION_bencoding
-          return $ Left $ KError ProtocolError (BC.pack msg) (queryId m)
-#else
-          return $ Left $ decodeError "TODO TOX ProtocolError" (queryId m)
-#endif
+          return $ Left $ KError ProtocolError (BC.pack msg) (envelopeTransaction m)
 
         Right a -> do -- KQueryArgs
           $(logDebugS) "handler.success" signature
@@ -522,41 +491,30 @@ runHandler h addr m = Lifted.catches wrapper failbacks
     failbacks =
       [ E.Handler $ \ (e :: HandlerFailure) -> do
           $(logDebugS) "handler.failed" signature
-#ifdef VERSION_bencoding
-          return $ Left $ KError ProtocolError (prettyHF e) (queryId m)
-#else
-          return $ Left $ decodeError "TODO TOX ProtocolError 2" (queryId m)
-#endif
+          return $ Left $ KError ProtocolError (prettyHF e) (envelopeTransaction m)
 
 
         -- may happen if handler makes query and fail
       , E.Handler $ \ (e :: QueryFailure) -> do
-#ifdef VERSION_bencoding
-          return $ Left $ KError ServerError (prettyQF e) (queryId m)
-#else
-          return $ Left $ decodeError "TODO TOX ServerError" (queryId m)
-#endif
+          return $ Left $ KError ServerError (prettyQF e) (envelopeTransaction m)
 
         -- since handler thread exit after sendMessage we can safely
         -- suppress async exception here
       , E.Handler $ \ (e :: SomeException) -> do
-#ifdef VERSION_bencoding
-          return $ Left $ KError GenericError (BC.pack (show e)) (queryId m)
-#else
-          return $ Left $ decodeError "TODO TOX GenericError" (queryId m)
-#endif
+          return $ Left $ KError GenericError (BC.pack (show e)) (envelopeTransaction m)
       ]
 
-dispatchHandler :: MonadKRPC h m => KQuery -> SockAddr -> m KResult
-dispatchHandler q addr = do
+dispatchHandler :: ( MonadKRPC h m raw msg
+                   , Eq (QueryMethod msg)
+                   , Show (QueryMethod msg)
+                   , Serialize (TransactionID msg)
+                   , Envelope msg
+                   ) => QueryMethod msg -> msg raw -> SockAddr -> m (KResult msg raw)
+dispatchHandler meth q addr = do
   Manager {..} <- getManager
-  case L.lookup (queryMethod q) handlers of
-#ifdef VERSION_bencoding
-    Nothing -> return $ Left $ KError MethodUnknown (queryMethod q) (queryId q)
-#else
-    Nothing -> return $ Left $ decodeError "TODO TOX Error MethodUnknown" (queryId q)
-#endif
-    Just h  -> runHandler h addr q
+  case L.lookup meth handlers of
+    Nothing -> return $ Left $ KError MethodUnknown ("Unknown method " <> BC.pack (show meth)) (envelopeTransaction q)
+    Just h  -> runHandler meth h addr q
 
 {-----------------------------------------------------------------------
 --  Listener
@@ -569,71 +527,75 @@ dispatchHandler q addr = do
 -- peer B fork too many threads
 -- ... space leak
 --
-handleQuery :: MonadKRPC h m => KQueryArgs -> KQuery -> SockAddr -> m ()
-handleQuery raw q addr = void $ fork $ do
+handleQuery :: ( MonadKRPC h m raw msg
+               , WireFormat raw msg
+               , Eq (QueryMethod msg)
+               , Show (QueryMethod msg)
+               , Serialize (TransactionID msg)
+               ) => QueryMethod msg -> raw -> msg raw -> SockAddr -> m ()
+handleQuery meth raw q addr = void $ fork $ do
   myThreadId >>= liftIO . flip labelThread "KRPC.handleQuery"
   Manager {..} <- getManager
-  res <- dispatchHandler q addr
+  res <- dispatchHandler meth q addr
 #ifdef VERSION_bencoding
-  let  res' = either E id res
-       resbe = either toBEncode toBEncode res
-  $(logOther "q") $ T.unlines
-    [ either (const "<unicode-fail>") id $ T.decodeUtf8' (BL.toStrict $ showBEncode raw)
-    , "==>"
-    , either (const "<unicode-fail>") id $ T.decodeUtf8' (BL.toStrict $ showBEncode resbe)
-    ]
-  sendMessage sock addr $ encodeHeaders () res'
+  let  res' = either buildError Just res
+       ctx = error "TODO TOX ToxCipherContext 2 or () for Mainline"
+       resbs = fmap (encodeHeaders ctx) res' :: Maybe BS.ByteString
+-- TODO: Generalize this debug print.
+--     resbe = either toBEncode toBEncode res
+-- $(logOther "q") $ T.unlines
+--   [ either (const "<unicode-fail>") id $ T.decodeUtf8' (BL.toStrict $ showBEncode raw)
+--   , "==>"
+--   , either (const "<unicode-fail>") id $ T.decodeUtf8' (BL.toStrict $ showBEncode resbe)
+--   ]
+  maybe (return ()) (sendMessage sock addr) resbs
 #else
   -- Errors not sent for Tox.
   let ctx = error "TODO TOX ToxCipherContext 2"
   either (const $ return ()) (sendMessage sock addr . encodeHeaders ctx) res
 #endif
 
-handleResponse :: MonadKRPC h m => KQueryArgs -> KResult -> SockAddr -> m ()
+handleResponse :: ( MonadKRPC h m raw msg
+                  , Ord (TransactionID msg)
+                  , Envelope msg
+                  ) => raw -> KResult msg raw -> SockAddr -> m ()
 handleResponse raw result addr = do
   Manager {..} <- getManager
   liftIO $ do
-#ifdef VERSION_bencoding
     let resultId = either errorId envelopeTransaction result
-#else
-    let resultId = either Tox.msgNonce Tox.msgNonce result
-#endif
     mcall <- unregisterQuery (resultId, addr) pendingCalls
     case mcall of
       Nothing   -> return ()
       Just ares -> putMVar ares (raw,result)
 
-#ifdef VERSION_bencoding
-handleMessage :: MonadKRPC h m => KQueryArgs -> KMessage -> SockAddr -> m ()
-handleMessage raw (Q q) = handleQuery    raw q
-handleMessage raw (R r) = handleResponse raw (Right (R r))
-handleMessage raw (E e) = handleResponse raw (Left  e)
-#else
-handleMessage :: MonadKRPC h m => KQueryArgs -> Tox.Message BC.ByteString -> SockAddr -> m ()
-handleMessage raw q | Tox.isQuery q    = handleQuery    raw q
-handleMessage raw r | Tox.isResponse r = handleResponse raw (Right r)
-handleMessage raw e | Tox.isError e    = handleResponse raw (Left  e)
-#endif
-
-listener :: MonadKRPC h m => m ()
-listener = do
+data Protocol raw (msg :: * -> *) = Protocol { rawProxy :: !(Proxy raw)
+                                             , msgProxy :: !(Proxy msg)
+                                             }
+
+listener :: forall h m raw msg.
+            ( MonadKRPC h m raw msg
+            , WireFormat raw msg
+            , Ord (TransactionID msg)
+            , Eq (QueryMethod msg)
+            , Show (QueryMethod msg)
+            , Serialize (TransactionID msg)
+            ) => Protocol raw msg -> m ()
+listener p = do
   Manager {..} <- getManager
   fix $ \again -> do
-    let ctx = error "TODO TOX ToxCipherContext 3"
+    let ctx = error "TODO TOX ToxCipherContext or () for Mainline"
     (bs, addr) <- liftIO $ do
       handle exceptions $ BS.recvFrom sock (optMaxMsgSize options)
-#ifdef VERSION_bencoding
-    case BE.parse bs >>= \r -> (,) r <$> BE.decode bs of
-#else
-    case return bs >>= \r -> (,) r <$> decodeHeaders ctx bs of
-#endif
-      -- TODO ignore unknown messages at all?
-#ifdef VERSION_bencoding
-      Left  e       -> liftIO $ sendMessage sock addr $ encodeHeaders () (E (unknownMessage e) :: KMessage)
-#else
-      Left  _       -> return () -- TODO TOX send unknownMessage error
-#endif
-      Right (raw,m) -> handleMessage raw m addr
+    case parsePacket (msgProxy p) bs >>= \r -> (,) r <$> decodeHeaders ctx r of
+      Left  e       -> -- XXX: Send parse failure message?
+                       --      liftIO $ sendMessage sock addr $ encodeHeaders ctx (unknownMessage e)
+                       return () -- Without transaction id, error message isn't very useful.
+      Right (raw,m) ->
+        case envelopeClass m of
+            Query meth  -> handleQuery meth (raw::raw) m         addr
+            Response _  -> handleResponse   raw        (Right m) addr
+            Error e     -> handleResponse   raw        (Left  e) addr
+
     again
   where
     exceptions :: IOError -> IO (BS.ByteString, SockAddr)
@@ -644,11 +606,17 @@ listener = do
 
 -- | Should be run before any 'query', otherwise they will never
 -- succeed.
-listen :: MonadKRPC h m => m ()
-listen = do
+listen :: ( MonadKRPC h m raw msg
+          , WireFormat raw msg
+          , Ord (TransactionID msg)
+          , Eq (QueryMethod msg)
+          , Show (QueryMethod msg)
+          , Serialize (TransactionID msg)
+          ) => Protocol raw msg -> m ()
+listen p = do
   Manager {..} <- getManager
   tid <- fork $ do
     myThreadId >>= liftIO . flip labelThread "KRPC.listen"
-    listener `Lifted.finally`
+    listener p `Lifted.finally`
       liftIO (takeMVar listenerThread)
   liftIO $ putMVar listenerThread tid
diff --git a/src/Network/DatagramServer/Error.hs b/src/Network/DatagramServer/Error.hs
new file mode 100644
index 00000000..2cbb76c3
--- /dev/null
+++ b/src/Network/DatagramServer/Error.hs
@@ -0,0 +1,110 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE DeriveDataTypeable         #-}
+module Network.DatagramServer.Error where
+
+import Control.Exception.Lifted as Lifted
+#ifdef VERSION_bencoding
+import Data.BEncode as BE
+#endif
+import Data.ByteString (ByteString)
+import Data.ByteString.Char8 as Char8
+import Data.Data
+import Data.Default
+import Data.Typeable
+
+{-----------------------------------------------------------------------
+-- Error messages
+-----------------------------------------------------------------------}
+
+-- | Types of RPC errors.
+data ErrorCode
+    -- | Some error doesn't fit in any other category.
+  = GenericError
+
+    -- | Occur when server fail to process procedure call.
+  | ServerError
+
+    -- | Malformed packet, invalid arguments or bad token.
+  | ProtocolError
+
+    -- | Occur when client trying to call method server don't know.
+  | MethodUnknown
+    deriving (Show, Read, Eq, Ord, Bounded, Typeable, Data)
+
+-- | According to the table:
+-- <http://bittorrent.org/beps/bep_0005.html#errors>
+instance Enum ErrorCode where
+  fromEnum GenericError  = 201
+  fromEnum ServerError   = 202
+  fromEnum ProtocolError = 203
+  fromEnum MethodUnknown = 204
+  {-# INLINE fromEnum #-}
+
+  toEnum 201 = GenericError
+  toEnum 202 = ServerError
+  toEnum 203 = ProtocolError
+  toEnum 204 = MethodUnknown
+  toEnum _   = GenericError
+  {-# INLINE toEnum #-}
+
+#ifdef VERSION_bencoding
+instance BEncode ErrorCode where
+  toBEncode = toBEncode . fromEnum
+  {-# INLINE toBEncode #-}
+
+  fromBEncode b = toEnum <$> fromBEncode b
+  {-# INLINE fromBEncode #-}
+#endif
+
+-- | Errors are sent when a query cannot be fulfilled. Error message
+--   can be send only from server to client but not in the opposite
+--   direction.
+--
+data KError tid = KError
+  { errorCode    :: !ErrorCode     -- ^ the type of error;
+  , errorMessage :: !ByteString    -- ^ human-readable text message;
+  , errorId      :: !tid           -- ^ match to the corresponding 'queryId'.
+  } deriving ( Show, Eq, Ord, Typeable, Data, Read )
+
+-- | Errors, or KRPC message dictionaries with a \"y\" value of \"e\",
+--   contain one additional key \"e\". The value of \"e\" is a
+--   list. The first element is an integer representing the error
+--   code. The second element is a string containing the error
+--   message.
+--
+--   Example Error Packet:
+--
+--   > { "t": "aa", "y":"e", "e":[201, "A Generic Error Ocurred"]}
+--
+--   or bencoded:
+--
+--   > d1:eli201e23:A Generic Error Ocurrede1:t2:aa1:y1:ee
+--
+#ifdef VERSION_bencoding
+instance (Typeable tid, BEncode tid) => BEncode (KError tid) where
+  toBEncode KError {..} = toDict $
+       "e" .=! (errorCode, errorMessage)
+    .: "t" .=! errorId
+    .: "y" .=! ("e" :: ByteString)
+    .: endDict
+  {-# INLINE toBEncode #-}
+
+  fromBEncode = fromDict $ do
+    lookAhead $ match "y" (BString "e")
+    (code, msg) <- field (req "e")
+    KError code msg <$>! "t"
+  {-# INLINE fromBEncode #-}
+#endif
+
+instance (Typeable tid, Show tid) => Exception (KError tid)
+
+-- | Received 'queryArgs' or 'respVals' can not be decoded.
+decodeError :: String -> tid -> KError tid
+decodeError msg = KError ProtocolError (Char8.pack msg)
+
+-- | A remote node has send some 'KMessage' this node is unable to
+-- decode.
+unknownMessage :: Default tid => String -> KError tid
+unknownMessage msg = KError ProtocolError (Char8.pack msg) def
+
+
diff --git a/src/Network/DatagramServer/Mainline.hs b/src/Network/DatagramServer/Mainline.hs
index 70b9b184..17f9dd60 100644
--- a/src/Network/DatagramServer/Mainline.hs
+++ b/src/Network/DatagramServer/Mainline.hs
@@ -23,6 +23,8 @@
 {-# LANGUAGE MultiParamTypeClasses  #-}
 {-# LANGUAGE OverloadedStrings      #-}
 {-# LANGUAGE TypeSynonymInstances   #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 module Network.DatagramServer.Mainline
        ( -- * Transaction
          TransactionId
@@ -57,6 +59,9 @@ module Network.DatagramServer.Mainline
        , KMessage
        , KQueryArgs
 
+       , NodeId(..)
+       , nodeIdSize
+
        ) where
 
 import Control.Applicative
@@ -67,12 +72,23 @@ import Data.BEncode as BE
 #else
 import qualified Network.DatagramServer.Tox as Tox
 #endif
-import Data.ByteString as B
-import Data.ByteString.Char8 as BC
+import Network.DatagramServer.Types
+import Data.Bits
+import Data.ByteString.Base16          as Base16
+import Data.ByteString                 (ByteString)
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as Char8
+import qualified Data.ByteString.Lazy  as L
+import Data.Default
+import Data.LargeWord
 import qualified Data.Serialize as S
+import Data.Serialize (Serialize, get, put, remaining, getBytes, putByteString)
+import Data.String
 import Data.Word
 import Data.Typeable
 import Network.Socket (SockAddr (..),PortNumber,HostAddress)
+import Text.PrettyPrint                as PP hiding ((<>))
+import Text.PrettyPrint.HughesPJClass  hiding (($$), (<>))
 
 
 #ifdef VERSION_bencoding
@@ -81,7 +97,7 @@ import Network.Socket (SockAddr (..),PortNumber,HostAddress)
 -- multiple queries to the same node. The transaction ID should be
 -- encoded as a short string of binary numbers, typically 2 characters
 -- are enough as they cover 2^16 outstanding queries.
-type TransactionId = ByteString
+type TransactionId = TransactionID KMessageOf
 #else
 type TransactionId = Tox.Nonce24 -- msgNonce
 #endif
@@ -94,113 +110,6 @@ unknownTransaction = 0
 #endif
 
 {-----------------------------------------------------------------------
--- Error messages
------------------------------------------------------------------------}
-
--- | Types of RPC errors.
-data ErrorCode
-    -- | Some error doesn't fit in any other category.
-  = GenericError
-
-    -- | Occur when server fail to process procedure call.
-  | ServerError
-
-    -- | Malformed packet, invalid arguments or bad token.
-  | ProtocolError
-
-    -- | Occur when client trying to call method server don't know.
-  | MethodUnknown
-    deriving (Show, Read, Eq, Ord, Bounded, Typeable)
-
--- | According to the table:
--- <http://bittorrent.org/beps/bep_0005.html#errors>
-instance Enum ErrorCode where
-  fromEnum GenericError  = 201
-  fromEnum ServerError   = 202
-  fromEnum ProtocolError = 203
-  fromEnum MethodUnknown = 204
-  {-# INLINE fromEnum #-}
-
-  toEnum 201 = GenericError
-  toEnum 202 = ServerError
-  toEnum 203 = ProtocolError
-  toEnum 204 = MethodUnknown
-  toEnum _   = GenericError
-  {-# INLINE toEnum #-}
-
-#ifdef VERSION_bencoding
-instance BEncode ErrorCode where
-  toBEncode = toBEncode . fromEnum
-  {-# INLINE toBEncode #-}
-
-  fromBEncode b = toEnum <$> fromBEncode b
-  {-# INLINE fromBEncode #-}
-#endif
-
-#ifdef VERSION_bencoding
--- | Errors are sent when a query cannot be fulfilled. Error message
---   can be send only from server to client but not in the opposite
---   direction.
---
-data KError = KError
-  { errorCode    :: !ErrorCode     -- ^ the type of error;
-  , errorMessage :: !ByteString    -- ^ human-readable text message;
-  , errorId      :: !TransactionId -- ^ match to the corresponding 'queryId'.
-  } deriving ( Show, Eq, Ord, Typeable, Read )
-#else
-type KError = Tox.Message ByteString -- TODO TOX unused
-#endif
-
--- | Errors, or KRPC message dictionaries with a \"y\" value of \"e\",
---   contain one additional key \"e\". The value of \"e\" is a
---   list. The first element is an integer representing the error
---   code. The second element is a string containing the error
---   message.
---
---   Example Error Packet:
---
---   > { "t": "aa", "y":"e", "e":[201, "A Generic Error Ocurred"]}
---
---   or bencoded:
---
---   > d1:eli201e23:A Generic Error Ocurrede1:t2:aa1:y1:ee
---
-#ifdef VERSION_bencoding
-instance BEncode KError where
-  toBEncode KError {..} = toDict $
-       "e" .=! (errorCode, errorMessage)
-    .: "t" .=! errorId
-    .: "y" .=! ("e" :: ByteString)
-    .: endDict
-  {-# INLINE toBEncode #-}
-
-  fromBEncode = fromDict $ do
-    lookAhead $ match "y" (BString "e")
-    (code, msg) <- field (req "e")
-    KError code msg <$>! "t"
-  {-# INLINE fromBEncode #-}
-#endif
-
-instance Exception KError
-
--- | Received 'queryArgs' or 'respVals' can not be decoded.
-decodeError :: String -> TransactionId -> KError
-#ifdef VERSION_bencoding
-decodeError msg = KError ProtocolError (BC.pack msg)
-#else
-decodeError msg = error "TODO TOX Error packet"
-#endif
-
--- | A remote node has send some 'KMessage' this node is unable to
--- decode.
-unknownMessage :: String -> KError
-#ifdef VERSION_bencoding
-unknownMessage msg = KError ProtocolError (BC.pack msg) unknownTransaction
-#else
-unknownMessage msg = error "TODO TOX Protocol error"
-#endif
-
-{-----------------------------------------------------------------------
 -- Query messages
 -----------------------------------------------------------------------}
 
@@ -259,21 +168,18 @@ queryMethod = Tox.msgType
 queryId     = Tox.msgNonce
 #endif
 
-newtype ReflectedIP = ReflectedIP SockAddr
-  deriving (Eq, Ord, Show)
-
 port16 :: Word16 -> PortNumber
 port16 = fromIntegral
 
 decodeAddr :: ByteString -> Either String SockAddr
-decodeAddr bs | B.length bs == 6
+decodeAddr bs | BS.length bs == 6
     = ( \(a,p) -> SockAddrInet <$> fmap port16 p <*> a )
       $ (S.runGet S.getWord32host *** S.decode )
-      $ B.splitAt 4 bs
-decodeAddr bs | B.length bs == 18
+      $ BS.splitAt 4 bs
+decodeAddr bs | BS.length bs == 18
     = ( \(a,p) -> flip SockAddrInet6 0 <$> fmap port16 p <*> a <*> pure 0 )
       $ (S.decode *** S.decode )
-      $ B.splitAt 16 bs
+      $ BS.splitAt 16 bs
 decodeAddr _ = Left "incorrectly sized address and port"
 
 encodeAddr :: SockAddr -> ByteString
@@ -281,7 +187,7 @@ encodeAddr (SockAddrInet port addr)
     = S.runPut (S.putWord32host addr >> S.put (fromIntegral port :: Word16))
 encodeAddr (SockAddrInet6 port _ addr _)
     = S.runPut (S.put addr >> S.put (fromIntegral port :: Word16))
-encodeAddr _ = B.empty
+encodeAddr _ = BS.empty
 
 {-----------------------------------------------------------------------
 -- Response messages
@@ -345,7 +251,7 @@ respIP         = Nothing :: Maybe ReflectedIP
 data KMessageOf a
   = Q (KQueryOf a)
   | R (KResponseOf a)
-  | E KError
+  | E (KError TransactionId)
     deriving (Show, Eq, Functor, Foldable, Traversable)
 
 type KMessage = KMessageOf KQueryArgs
@@ -364,3 +270,95 @@ instance BEncode KMessage where
 type KMessageOf = Tox.Message
 type KMessage = KMessageOf B.ByteString
 #endif
+
+nodeIdSize :: Int
+nodeIdSize = finiteBitSize (undefined :: NodeId KMessageOf) `div` 8
+
+instance BEncode (NodeId KMessageOf) where
+    toBEncode (NodeId w) = toBEncode $ S.encode w
+    fromBEncode bval = fromBEncode bval >>= S.decode
+
+-- instance BEncode NodeId where TODO
+
+-- TODO: put this somewhere appropriate
+instance (Serialize a, Serialize b) => Serialize (LargeKey a b) where
+   put (LargeKey lo hi) = put hi >> put lo
+   get = flip LargeKey <$> get <*> get
+
+instance Serialize (NodeId KMessageOf) where
+  get = NodeId <$> get
+  {-# INLINE get #-}
+  put (NodeId bs) = put bs
+  {-# INLINE put #-}
+
+-- | ASCII encoded.
+instance IsString (NodeId KMessageOf) where
+  fromString str
+    | length str == nodeIdSize     = NodeId (either error id $ S.decode (fromString str :: ByteString))
+    | length str == 2 * nodeIdSize = NodeId (either error id $ S.decode (fst $ Base16.decode $ fromString str))
+    |           otherwise = error "fromString: invalid NodeId length"
+  {-# INLINE fromString #-}
+
+-- | Meaningless node id, for testing purposes only.
+instance Default (NodeId KMessageOf) where
+  def = NodeId 0
+
+-- | base16 encoded.
+instance Pretty (NodeId KMessageOf) where
+  pPrint (NodeId nid) = PP.text $ Char8.unpack $ Base16.encode $ S.encode nid
+
+
+instance Serialize (TransactionID KMessageOf) where
+    get = do
+       cnt <- remaining
+       TID <$> getBytes cnt
+
+    put (TID bs) = putByteString bs
+
+
+instance Envelope KMessageOf where
+    type QueryMethod KMessageOf = ByteString
+
+    newtype TransactionID KMessageOf = TID ByteString
+        deriving (Eq,Ord,IsString,Show,Read,BEncode)
+
+    -- | Each node has a globally unique identifier known as the \"node
+    -- ID.\"
+    --
+    --   Normally, /this/ node id should be saved between invocations
+    --   of the client software.
+    newtype NodeId KMessageOf = NodeId Word160
+      deriving (Show, Eq, Ord, Typeable, Bits, FiniteBits)
+
+    envelopePayload (Q q) = queryArgs q
+    envelopePayload (R r) = respVals r
+    envelopePayload (E _) = error "TODO: messagePayload for KError"
+
+    envelopeTransaction (Q q) = queryId q
+    envelopeTransaction (R r) = respId r
+    envelopeTransaction (E e) = errorId e
+
+    envelopeClass (Q q) = Query (queryMethod q)
+    envelopeClass (R r) = Response (respIP r)
+    envelopeClass (E e) = Error e
+
+    buildReply self addr qry response =
+        (R (KResponse response (envelopeTransaction qry) (Just $ ReflectedIP addr)))
+
+    buildQuery self addr meth tid qry = return $ Q (KQuery qry meth tid)
+
+    uniqueTransactionId cnt = return $ TID $ Char8.pack (show cnt)
+
+instance WireFormat BValue KMessageOf where
+    type SerializableTo BValue = BEncode
+    type CipherContext BValue KMessageOf = ()
+
+    parsePacket _ = BE.decode
+
+    buildError = Just . E
+
+    decodeHeaders _ = BE.fromBEncode
+    decodePayload kmsg = mapM BE.fromBEncode kmsg
+
+    encodeHeaders _ kmsg = L.toStrict $ BE.encode kmsg
+    encodePayload msg = fmap BE.toBEncode msg
diff --git a/src/Network/DatagramServer/Tox.hs b/src/Network/DatagramServer/Tox.hs
index ad376c68..2f48b512 100644
--- a/src/Network/DatagramServer/Tox.hs
+++ b/src/Network/DatagramServer/Tox.hs
@@ -15,6 +15,9 @@ module Network.DatagramServer.Tox where
 
 import Data.Bits
 import Data.ByteString (ByteString)
+import qualified Data.Serialize as S
+import qualified Data.ByteString.Lazy  as L
+import qualified Data.ByteString.Char8 as Char8
 import Data.Data (Data)
 import Data.Word
 import Data.LargeWord
@@ -253,7 +256,9 @@ curve25519 = CurveFP (CurvePrime prime curvecommon)
 
 
 instance Envelope Message where
-    type TransactionID Message = Nonce24
+    newtype TransactionID Message = TID Nonce24
+        deriving (Eq,Ord,Show,Read,Serialize)
+
     newtype NodeId Message = NodeId Word256
         deriving (Serialize, Eq, Ord, Bits, FiniteBits)
 
@@ -268,6 +273,10 @@ instance Envelope Message where
 
     buildReply self addr qry payload = (fmap (const payload) qry) { msgClient = self }
 
+    uniqueTransactionId cnt = do
+      return $ either (error "failed to create TransactionId") TID
+             $ S.decode $ Char8.pack (L.take 24 $ show cur ++ L.repeat ' ')
+
 instance WireFormat ByteString Message where
     type SerializableTo ByteString = Serialize
     type CipherContext ByteString Message = ToxCipherContext
diff --git a/src/Network/DatagramServer/Types.hs b/src/Network/DatagramServer/Types.hs
index ac18e6ce..9c8f3ded 100644
--- a/src/Network/DatagramServer/Types.hs
+++ b/src/Network/DatagramServer/Types.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE DeriveFunctor              #-}
 {-# LANGUAGE DeriveFoldable             #-}
 {-# LANGUAGE DeriveTraversable          #-}
+{-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE FlexibleInstances          #-}
 {-# LANGUAGE FlexibleContexts       #-}
 {-# LANGUAGE FunctionalDependencies #-}
@@ -11,7 +12,10 @@
 {-# LANGUAGE ScopedTypeVariables    #-}
 {-# LANGUAGE TypeFamilies           #-}
 {-# LANGUAGE StandaloneDeriving     #-}
-module Network.DatagramServer.Types where
+module Network.DatagramServer.Types
+        ( module Network.DatagramServer.Types
+        , module Network.DatagramServer.Error
+        ) where
 
 import Control.Applicative
 import qualified Text.ParserCombinators.ReadP as RP
@@ -37,6 +41,7 @@ import qualified Data.ByteString.Char8 as Char8
 import qualified Data.ByteString as BS
 import Data.ByteString.Base16          as Base16
 import System.Entropy
+import Network.DatagramServer.Error
 
 class (Eq a, Serialize a, Typeable a, Hashable a, Pretty a)
     => Address a where
@@ -69,16 +74,25 @@ instance Address IP where
 
 
 
-data MessageClass = Error | Query | Response
- deriving (Eq,Ord,Enum,Bounded,Data,Show,Read)
+type MessageClass msg = MessageClassG (QueryMethod msg) (TransactionID msg)
+
+newtype ReflectedIP = ReflectedIP SockAddr
+  deriving (Eq, Ord, Show)
+
+data MessageClassG meth tid = Query meth
+                            | Response (Maybe ReflectedIP)
+                            | Error (KError tid)
+ deriving (Eq,Ord,Show) --  ,Read, Data: not implemented by SockAddr
+
 
 class Envelope envelope where
-    type TransactionID envelope
+    data TransactionID envelope
+    type QueryMethod envelope
     data NodeId envelope
 
     envelopePayload     :: envelope a -> a
     envelopeTransaction :: envelope a -> TransactionID envelope
-    envelopeClass       :: envelope a -> MessageClass
+    envelopeClass       :: envelope a -> MessageClass envelope
 
     -- | > buildReply self addr qry response
     --
@@ -93,6 +107,10 @@ class Envelope envelope where
     -- Returns: response message envelope
     buildReply :: NodeId envelope -> SockAddr -> envelope a -> b -> envelope b
 
+    buildQuery :: NodeId envelope -> SockAddr -> QueryMethod envelope -> TransactionID envelope -> a -> IO (envelope a)
+
+    uniqueTransactionId :: Int -> IO (TransactionID envelope)
+
 -- | In Kademlia, the distance metric is XOR and the result is
 -- interpreted as an unsigned integer.
 newtype NodeDistance nodeid = NodeDistance nodeid
@@ -294,7 +312,15 @@ class Envelope envelope => WireFormat raw envelope where
     type SerializableTo raw :: * -> Constraint
     type CipherContext raw envelope
 
-    decodeHeaders :: CipherContext raw envelope -> ByteString -> Either String (envelope raw)
+    parsePacket :: Proxy envelope -> ByteString -> Either String raw
+
+    default parsePacket :: Proxy envelope -> ByteString -> Either String ByteString
+    parsePacket _ = Right
+
+    buildError :: KError (TransactionID envelope) -> Maybe (envelope raw)
+    buildError _ = Nothing
+
+    decodeHeaders :: CipherContext raw envelope -> raw -> Either String (envelope raw)
     decodePayload :: SerializableTo raw a => envelope raw -> Either String (envelope a)
 
     encodeHeaders :: CipherContext raw envelope -> envelope raw -> ByteString