IDClash when connecting more than 2 nodes

[MasseR]

I can connect two peers just fine, but from the third node onwards I get 'IDClash' on connecting to the network. I'm printing debugPeers and I can see that the third node contains itself in the peer list. The first two only contains the other peer nodes.

I'm using the following for testing:

#! /usr/bin/env nix-shell
#! nix-shell -i runghc -p "haskellPackages.ghcWithPackages (pkgs: with pkgs; [kademlia cryptonite uuid])"

{-# Language DeriveGeneric #-}
{-# Language OverloadedStrings #-}
{-# Language LambdaCase #-}
module Main where

import qualified Network.Kademlia as K
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Lazy as BL
import qualified Data.Binary as BS
import Control.Arrow (first)
import GHC.Generics (Generic)
import Control.Exception
import System.Environment (getArgs)
import Control.Monad (when, forever)
import Control.Concurrent (threadDelay, myThreadId)
import Data.Monoid ((<>))
import Crypto.Hash
import Data.ByteArray (convert)

data Person = Person { age :: Int , name :: String }
            deriving (Show, Eq, Ord, Generic)

instance BS.Binary Person


instance K.Serialize Person where
  toBS = BL.toStrict . BS.encode
  fromBS bs =
    let person = BS.decode (BL.fromStrict bs)
    in Right (person, "")

keySize :: Int
keySize = 32

newtype KademliaID = KademliaID B.ByteString deriving (Show, Eq, Ord)

toKey :: B.ByteString -> KademliaID
toKey bs = KademliaID (convert (hashWith SHA256 bs))

instance K.Serialize KademliaID where
   toBS (KademliaID bs)
       | B.length bs >= keySize = B.take keySize bs
       | otherwise        = error "KademliaID to short!"

   fromBS bs
       | B.length bs >= keySize = Right . first KademliaID . B.splitAt keySize $ bs
       | otherwise        = Left "ByteString too short!"

withKademlia :: Int -> KademliaID -> (K.KademliaInstance KademliaID Person -> IO ()) -> IO ()
withKademlia port name f =
  bracket (K.create port name)
          K.close
          f

debugger :: K.KademliaInstance KademliaID Person -> IO ()
debugger inst = forever $ do
  peers <- fmap K.peer <$> K.dumpPeers inst
  putStrLn $ show (length peers) <> " peers"
  print peers
  -- let key = (toKey "foobar")
  -- K.lookup inst key >>= print
  threadDelay 5000000

joinInstance :: Int -> KademliaID -> K.KademliaInstance KademliaID Person -> IO ()
joinInstance port name inst =
  K.joinNetwork inst (K.Node (K.Peer "127.0.0.1" (fromIntegral port)) name) >>= \case
    K.JoinSucces -> do
      peers <- K.dumpPeers inst
      print peers
      when (length peers > 4) $ do
        let key = (toKey "foobar")
        let person = Person 25 "Alan Turing"
        K.store inst key person
      threadDelay 1000000
    err -> print err

main :: IO ()
main =
  getArgs >>= \case
    [port, name] -> withKademlia (read port) (toKey $ C.pack name) debugger
    [port, name, remotePort, remoteName] -> withKademlia (read port) (toKey $ C.pack name) (\inst -> joinInstance (read remotePort) (toKey $ C.pack remoteName) inst >> debugger inst)

• ./kademlia.hs 12345 hello for starting a bootstrap node
• ./kademlia.hs <port> $(uuidgen) 12345 hello for starting a peer