Bootstrap fixes.

1 files changed, 59 insertions, 9 deletions

diff --git a/Mainline.hs b/Mainline.hs
index 911f0dbc..b24f847d 100644
--- a/Mainline.hs
+++ b/Mainline.hs
@@ -73,6 +73,9 @@ import Control.Concurrent.Lifted
 import GHC.Conc                  (labelThread)
 #endif
 import Control.Exception (SomeException(..),handle)
+import Data.Aeson (FromJSON,ToJSON,(.=))
+import qualified Data.Aeson as JSON
+import Text.Read
 
 newtype NodeId = NodeId ByteString
  deriving (Eq,Ord,ByteArrayAccess, BEncode, Bits, Hashable)
@@ -97,6 +100,36 @@ data NodeInfo = NodeInfo
   }
  deriving (Eq,Ord)
 
+instance ToJSON NodeInfo where
+    toJSON (NodeInfo nid (IPv4 ip) port)
+        = JSON.object [ "node-id" .= show nid
+                      , "ipv4" .= show ip
+                      , "port" .= (fromIntegral port :: Int)
+                      ]
+    toJSON (NodeInfo nid (IPv6 ip6) port)
+        | Just ip <- un4map ip6
+          = JSON.object [ "node-id" .= 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..: "node-id"
+        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 (Char8.pack nidstr)
+        guard (B.length bs == 20)
+        return $ NodeInfo (NodeId bs) ip (fromIntegral (portnum :: Word16))
+
+
 -- The Hashable instance depends only on the IP address and port number.  It is
 -- used to compute the announce token.
 instance Hashable NodeInfo where
@@ -145,11 +178,14 @@ putNodeInfo6 (NodeInfo (NodeId nid) (IPv6 ip) port)
 putNodeInfo6 _ = return ()
 
 
--- TODO: We should use a SocketAddrInet6 address for a dual-stack listen
--- socket.  Therefore, the behavior of this method should depend on the bind
--- address for outbound packets.
+-- | TODO: This should depend on the bind address to support IPv4-only. For
+-- now, in order to support dual-stack listen, we're going to assume IPv6 is
+-- wanted and map IPv4 addresses accordingly.
 nodeAddr :: NodeInfo -> SockAddr
-nodeAddr (NodeInfo _ ip port) = setPort port $ toSockAddr ip
+nodeAddr (NodeInfo _ ip port) =
+    case ip of
+        IPv4 ip4 -> setPort port $ toSockAddr (ipv4ToIPv6 ip4)
+        IPv6 ip6 -> setPort port $ toSockAddr ip6
 
 nodeInfo :: NodeId -> SockAddr -> Either String NodeInfo
 nodeInfo nid saddr
@@ -503,6 +539,16 @@ newClient addr = do
 
 -- | Modifies a purely random 'NodeId' to one that is related to a given
 -- routable address in accordance with BEP 42.
+--
+-- Test vectors from the spec:
+--
+-- IP           rand  example node ID
+-- ============ ===== ==========================================
+-- 124.31.75.21   1   5fbfbf f10c5d6a4ec8a88e4c6ab4c28b95eee4 01
+-- 21.75.31.124  86   5a3ce9 c14e7a08645677bbd1cfe7d8f956d532 56
+-- 65.23.51.170  22   a5d432 20bc8f112a3d426c84764f8c2a1150e6 16
+-- 84.124.73.14  65   1b0321 dd1bb1fe518101ceef99462b947a01ff 41
+-- 43.213.53.83  90   e56f6c bf5b7c4be0237986d5243b87aa6d5130 5a
 bep42 :: SockAddr -> NodeId -> Maybe NodeId
 bep42 addr (NodeId r)
  | Just ip <- fmap S.encode (fromSockAddr addr :: Maybe IPv4)
@@ -513,10 +559,9 @@ bep42 addr (NodeId r)
  where
     ip4mask = "\x03\x0f\x3f\xff" :: ByteString
     ip6mask = "\x01\x03\x07\x0f\x1f\x3f\x7f\xff" :: ByteString
-    nbhood_select = (B.last r :: Word8) .&. 7
-    nodeIdSize = 20
-    retr n = pure $ B.drop (nodeIdSize - n) $ S.encode r
-    crc = (`B.append` B.replicate 16 0) . S.encode . crc32c . B.pack
+    nbhood_select = B.last r .&. 7
+    retr n = pure $ B.drop (B.length r - n) r
+    crc = S.encode . crc32c . B.pack
     applyMask ip = case B.zipWith (.&.) msk ip of
                     (b:bs) -> (b .|. shiftL nbhood_select 5) : bs
                     bs     -> bs
@@ -524,6 +569,7 @@ bep42 addr (NodeId r)
                   | otherwise         =  ip6mask
 
 
+
 defaultHandler :: ByteString -> Handler
 defaultHandler meth = MethodHandler decodePayload errorPayload returnError
  where
@@ -540,7 +586,11 @@ mainlineKademlia client committee var sched
                         io2 <- touchBucket mainlineSpace (15*60) var sched tr
                         return $ do
                             io1 >> io2
-                            hPutStrLn stderr ("Buckets: "++show tr)
+                            hPutStrLn stderr $ unwords
+                                [ "Buckets: "
+                                , show (transitionedTo tr)
+                                , show (transitioningNode tr)
+                                ]
                    }