WIP: Adapting DHT to Tox network (part 4).

1 files changed, 15 insertions, 12 deletions

diff --git a/src/Network/KRPC/Manager.hs b/src/Network/KRPC/Manager.hs
index 58ac7674..f31a3cd6 100644
--- a/src/Network/KRPC/Manager.hs
+++ b/src/Network/KRPC/Manager.hs
@@ -78,11 +78,13 @@ import Data.Tuple
 import Data.Typeable
 import Network.RPC
 import Network.KRPC.Message
-import Network.KRPC.Method
+import Network.KRPC.Method hiding (Envelope)
+import qualified Network.KRPC.Method as KRPC (Envelope)
 import Network.Socket hiding (listen)
 import Network.Socket.ByteString as BS
 import System.IO.Error
 import System.Timeout
+import Network.DHT.Mainline
 
 
 {-----------------------------------------------------------------------
@@ -130,14 +132,14 @@ validateOptions Options {..}
 --  Options
 -----------------------------------------------------------------------}
 
-type KResult = Either KError KResponse
+type KResult = Either KError KMessage -- 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 HandlerBody h msg v = SockAddr -> msg v -> h (Either String v)
+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.
@@ -362,7 +364,7 @@ queryK addr params kont = do
       case res of
 #ifdef VERSION_bencoding
         Left  (KError   c m _) -> throwIO $ QueryFailed c (T.decodeUtf8 m)
-        Right (KResponse {..}) ->
+        Right (R (KResponse {..})) ->
           case fromBEncode respVals of
             Right r -> pure $ kont raw r respIP
 #else
@@ -421,15 +423,16 @@ 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. (KRPC a b, Applicative h, Functor msg)
-        => Messaging msg TransactionId (Envelope a b) -> (SockAddr -> a -> h b) -> Handler h msg (Envelope a b)
-handler msging body = (name, wrapper)
+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)
   where
     Method name = method :: Method a b
+    wrapper :: SockAddr -> msg raw -> h (Either String (msg raw))
     wrapper addr args =
-      case unseal $ messagePayload msging args of
+      case decodePayload args of
         Left  e -> pure $ Left e
-        Right a -> Right . seal <$> body addr a
+        Right a -> Right . encodePayload . buildReply (error "self node-id") addr args <$> body addr (envelopePayload a)
 
 runHandler :: MonadKRPC h m
 #ifdef VERSION_bencoding
@@ -461,7 +464,7 @@ runHandler h addr m = Lifted.catches wrapper failbacks
         Right a -> do -- KQueryArgs
           $(logDebugS) "handler.success" signature
 #ifdef VERSION_bencoding
-          return $ Right $ KResponse a (queryId m) (Just $ ReflectedIP addr)
+          return $ Right a
 #else
           let cli = error "TODO TOX client node id"
               messageid = error "TODO TOX message response id"
@@ -542,7 +545,7 @@ handleResponse raw result addr = do
   Manager {..} <- getManager
   liftIO $ do
 #ifdef VERSION_bencoding
-    let resultId = either errorId respId  result
+    let resultId = either errorId envelopeTransaction result
 #else
     let resultId = either Tox.msgNonce Tox.msgNonce result
 #endif
@@ -554,7 +557,7 @@ handleResponse raw result addr = do
 #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)
+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 ()