JSON instances for Tox.NodeInfo

4 files changed, 67 insertions, 8 deletions

diff --git a/Mainline.hs b/Mainline.hs
index 4ce4f4da..28025d59 100644
--- a/Mainline.hs
+++ b/Mainline.hs
@@ -608,6 +608,7 @@ newClient addr = do
         forM_ ns $ \n -> do
             hPutStrLn stderr $ "Change IP, ping: "++show n
             ping outgoingClient n
+        -- TODO: trigger bootstrap ipv4
         again
     fork $ fix $ \again -> do
         myThreadId >>= flip labelThread "addr6"
@@ -616,6 +617,7 @@ newClient addr = do
         forM_ ns $ \n -> do
             hPutStrLn stderr $ "Change IP, ping: "++show n
             ping outgoingClient n
+        -- TODO: trigger bootstrap ipv6
         again
 
     refresh_thread4 <- forkPollForRefresh
diff --git a/Tox.hs b/Tox.hs
index 8a4fccb5..53aa9a5d 100644
--- a/Tox.hs
+++ b/Tox.hs
@@ -10,6 +10,7 @@
 {-# LANGUAGE TupleSections              #-}
 module Tox where
 
+import Control.Applicative
 import Control.Arrow
 import Control.Concurrent (MVar)
 import Control.Concurrent.STM
@@ -58,6 +59,10 @@ import Data.Time.Clock.POSIX                  (POSIXTime)
 import Global6
 import Data.Ord
 import System.IO
+import qualified Data.Aeson as JSON
+         ;import Data.Aeson (FromJSON, ToJSON, (.=))
+import Control.Monad
+import Text.Read
 
 newtype NodeId = NodeId ByteString
  deriving (Eq,Ord,ByteArrayAccess, Bits, Hashable)
@@ -89,6 +94,36 @@ data NodeInfo = NodeInfo
   }
  deriving (Eq,Ord)
 
+instance ToJSON NodeInfo where
+    toJSON (NodeInfo nid (IPv4 ip) port)
+        = JSON.object [ "public_key" .= show nid
+                      , "ipv4" .= show ip
+                      , "port" .= (fromIntegral port :: Int)
+                      ]
+    toJSON (NodeInfo nid (IPv6 ip6) port)
+        | Just ip <- un4map ip6
+          = JSON.object [ "public_key" .= show nid
+                        , "ipv4" .= show ip
+                        , "port" .= (fromIntegral port :: Int)
+                        ]
+        | otherwise
+          = JSON.object [ "node-id" .= show nid
+                        , "ipv6" .= show ip6
+                        , "port" .= (fromIntegral port :: Int)
+                        ]
+instance FromJSON NodeInfo where
+    parseJSON (JSON.Object v) = do
+        nidstr <- v JSON..: "public_key"
+        ip6str <- v JSON..:? "ipv6"
+        ip4str <- v JSON..:? "ipv4"
+        portnum <- v JSON..: "port"
+        ip <- maybe empty (return . IPv6) (ip6str >>= readMaybe)
+              <|> maybe empty (return . IPv4) (ip4str >>= readMaybe)
+        let (bs,_) = Base16.decode (C8.pack nidstr)
+        guard (B.length bs == 32)
+        return $ NodeInfo (NodeId bs) ip (fromIntegral (portnum :: Word16))
+
+
 instance S.Serialize NodeInfo where
     get = do
         nid <- S.get
@@ -569,3 +604,6 @@ gen g = let (bs, g')  = randomBytesGenerate 24 g
             Right w   = S.runGet S.getWord64be ws
         in ( TransactionId (Nonce8 w) (Nonce24 bs), g'' )
 
+
+ping :: ToxClient -> NodeInfo -> IO Bool
+ping = error "todo ping"
diff --git a/c b/c
index 1b5970d9..e98a6d7b 100755
--- a/c
+++ b/c
@@ -1,4 +1,5 @@
 #!/bin/sh
 defs="-DBENCODE_AESON -DTHREAD_DEBUG"
 hide="-hide-package crypto-random -hide-package crypto-api -hide-package crypto-numbers -hide-package cryptohash -hide-package prettyclass"
-ghc -freverse-errors $hide -isrc -XOverloadedStrings -XRecordWildCards $defs "$@"
+cbits="cbits/*.c"
+ghc -freverse-errors $hide -isrc -XOverloadedStrings -XRecordWildCards $defs $cbits "$@"
diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index ef225f0c..a1b8d665 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -49,6 +49,7 @@ import Network.QueryResponse
 import Network.StreamServer
 import Kademlia
 import qualified Mainline
+import qualified Tox
 import Network.DHT.Routing as R
 import Data.Aeson as J (ToJSON, FromJSON)
 import qualified Data.Aeson as J
@@ -280,7 +281,7 @@ clientSession s@Session{..} sock cnum h = do
                     pid <- getProcessID
                     hPutClient h (show pid)
         ("external-ip", _) -> cmd0 $ do
-                    unlines . map (either show show . Mainline.either4or6) <$> externalAddresses
+                    unlines . map (either show show . either4or6) <$> externalAddresses
                         >>= hPutClient h
 #ifdef THREAD_DEBUG
         ("threads", _) -> cmd0 $ do
@@ -470,10 +471,16 @@ main = do
 
     quitBt <- forkListener bt
 
-    tox <- return $ error "TODO: Tox.newClient"
-    quitTox <- return $ return () -- TODO: forkListener tox
+    let toxport = succ $ fromMaybe 33445 (fromIntegral <$> sockAddrPort addr)
+    addrTox <- getBindAddress (show toxport) True
+    (tox,toxR) <- Tox.newClient addrTox
+
+    -- TODO: load saved tox nodes.
+
+    quitTox <- forkListener tox
 
     mainlineSearches <- atomically $ newTVar Map.empty
+    toxSearches <- atomically $ newTVar Map.empty
 
     let mainlineDHT bkts = DHT
             { dhtBuckets = bkts btR
@@ -482,13 +489,13 @@ main = do
                             [ ("node", DHTQuery (Mainline.nodeSearch bt)
                                                 (\ni -> fmap Mainline.unwrapNodes
                                                         . Mainline.findNodeH btR ni
-                                                        . flip Mainline.FindNode (Just Mainline.Want_Both))
+                                                        . flip Mainline.FindNode (Just Want_Both))
                                                 show
                                                 (const Nothing))
                             , ("peer", DHTQuery (Mainline.peerSearch bt)
                                                 (\ni -> fmap Mainline.unwrapPeers
                                                         . Mainline.getPeersH btR swarms ni
-                                                        . flip Mainline.GetPeers (Just Mainline.Want_Both)
+                                                        . flip Mainline.GetPeers (Just Want_Both)
                                                         . (read . show)) -- TODO: InfoHash -> NodeId
                                                 (show . pPrint)
                                                 (Just . show))
@@ -496,9 +503,20 @@ main = do
             , dhtParseId  = readEither :: String -> Either String Mainline.NodeId
             , dhtSearches = mainlineSearches
             }
+        toxDHT bkts = DHT
+            { dhtBuckets = bkts toxR
+            , dhtPing    = Tox.ping tox
+            , dhtQuery   = Map.fromList
+                            [ -- "node"
+                            ]
+            , dhtParseId  = readEither :: String -> Either String Tox.NodeId
+            , dhtSearches = toxSearches
+            }
         dhts = Map.fromList
                 [ ("bt4", mainlineDHT Mainline.routing4)
                 , ("bt6", mainlineDHT Mainline.routing6)
+                , ("tox4", toxDHT Tox.routing4)
+                , ("tox6", toxDHT Tox.routing6)
                 ]
 
     waitForSignal <- do
@@ -521,7 +539,7 @@ main = do
     let bkts4 = Mainline.routing4 btR
     btSaved4 <- loadNodes "bt4" :: IO [Mainline.NodeInfo]
     putStrLn $ "Loaded "++show (length btSaved4)++" nodes for bt4."
-    fallbackNodes4 <- Mainline.bootstrapNodes Mainline.Want_IP4
+    fallbackNodes4 <- Mainline.bootstrapNodes Want_IP4
     fork $ do
         myThreadId >>= flip labelThread "bootstrap.Mainline4"
         bootstrap (Mainline.nodeSearch bt) bkts4 (Mainline.ping bt) btSaved4 fallbackNodes4
@@ -530,7 +548,7 @@ main = do
     btSaved6 <- loadNodes "bt6"
     putStrLn $ "Loaded "++show (length btSaved6)++" nodes for bt6."
     let bkts6 = Mainline.routing6 btR
-    fallbackNodes6 <- Mainline.bootstrapNodes Mainline.Want_IP6
+    fallbackNodes6 <- Mainline.bootstrapNodes Want_IP6
     fork $ do
         myThreadId >>= flip labelThread "bootstrap.Mainline6"
         bootstrap (Mainline.nodeSearch bt) bkts6 (Mainline.ping bt) btSaved6 fallbackNodes6