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

1 files changed, 18 insertions, 26 deletions

diff --git a/src/Network/KRPC/Manager.hs b/src/Network/KRPC/Manager.hs
index f31a3cd6..efd59f32 100644
--- a/src/Network/KRPC/Manager.hs
+++ b/src/Network/KRPC/Manager.hs
@@ -84,7 +84,9 @@ import Network.Socket hiding (listen)
 import Network.Socket.ByteString as BS
 import System.IO.Error
 import System.Timeout
+#ifdef VERSION_bencoding
 import Network.DHT.Mainline
+#endif
 
 
 {-----------------------------------------------------------------------
@@ -268,15 +270,9 @@ data QueryFailure
 
 instance Exception QueryFailure
 
-#ifdef VERSION_bencoding
-sendMessage :: MonadIO m => BEncode a => Socket -> SockAddr -> a -> m ()
-sendMessage sock addr a = do
-  liftIO $ sendManyTo sock (BL.toChunks (BE.encode a)) addr
-#else
 sendMessage :: MonadIO m => Socket -> SockAddr -> BC.ByteString -> m ()
 sendMessage sock addr a = do
   liftIO $ sendManyTo sock [a] addr
-#endif
 
 genTransactionId :: TransactionCounter -> IO TransactionId
 genTransactionId ref = do
@@ -309,13 +305,8 @@ unregisterQuery cid ref = do
 
 
 -- (sendmsg EINVAL)
-#ifdef VERSION_bencoding
-sendQuery :: BEncode a => Socket -> SockAddr -> a -> IO ()
+sendQuery :: Socket -> SockAddr -> BC.ByteString -> IO ()
 sendQuery sock addr q = handle sockError $ sendMessage sock addr q
-#else
-sendQuery :: Serialize a => Socket -> SockAddr -> a -> IO ()
-sendQuery sock addr q = handle sockError $ sendMessage sock addr (S.encode q)
-#endif
   where
     sockError :: IOError -> IO ()
     sockError _ = throwIO SendFailed
@@ -351,12 +342,17 @@ queryK addr params kont = do
     ares <- registerQuery (tid, addr) pendingCalls
 
 #ifdef VERSION_bencoding
-    let q = KQuery (toBEncode params) (methodName queryMethod) tid
+    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"
+        ctx = error "TODO TOX ToxCipherContext"
+        qb = encodePayload q :: Tox.Message BC.ByteString
+        qbs = encodeHeaders ctx qb :: BC.ByteString
 #endif
-    sendQuery sock addr q
+    sendQuery sock addr qbs
       `onException` unregisterQuery (tid, addr) pendingCalls
 
     timeout (optQueryTimeout options * 10 ^ (6 :: Int)) $ do
@@ -463,14 +459,7 @@ runHandler h addr m = Lifted.catches wrapper failbacks
 
         Right a -> do -- KQueryArgs
           $(logDebugS) "handler.success" signature
-#ifdef VERSION_bencoding
           return $ Right a
-#else
-          let cli = error "TODO TOX client node id"
-              messageid = error "TODO TOX message response id"
-              -- TODO: ReflectedIP addr ??
-          return $ Right $ Tox.Message messageid cli (queryId m) a
-#endif
 
     failbacks =
       [ E.Handler $ \ (e :: HandlerFailure) -> do
@@ -528,16 +517,18 @@ handleQuery raw q addr = void $ fork $ do
   Manager {..} <- getManager
   res <- dispatchHandler q addr
 #ifdef VERSION_bencoding
-  let resbe = either toBEncode toBEncode res
+  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 resbe
+  sendMessage sock addr $ encodeHeaders () res'
 #else
   -- Errors not sent for Tox.
-  either (const $ return ()) (sendMessage sock addr . S.encode) res
+  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 ()
@@ -570,16 +561,17 @@ listener :: MonadKRPC h m => m ()
 listener = do
   Manager {..} <- getManager
   fix $ \again -> do
+    let ctx = error "TODO TOX ToxCipherContext 3"
     (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 <$> decode bs of
+    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 $ unknownMessage e
+      Left  e       -> liftIO $ sendMessage sock addr $ encodeHeaders () (E (unknownMessage e) :: KMessage)
 #else
       Left  _       -> return () -- TODO TOX send unknownMessage error
 #endif