module Network.Kademlia.Types
( Peer(..)
, toPeer
, Node(..)
, sortByDistanceTo
, Serialize(..)
, Signal(..)
, Command(..)
, ByteStruct(..)
, toByteStruct
, fromByteStruct
, distance
) where
import Network.Socket (SockAddr(..), PortNumber, inet_ntoa, inet_addr)
import qualified Data.ByteString as B (ByteString, foldr, pack)
import Data.Bits (testBit, setBit, zeroBits)
import Data.List (sortBy)
import Data.Function (on)
data Peer = Peer {
peerHost :: String
, peerPort :: PortNumber
} deriving (Eq, Ord, Show)
data Node i = Node {
peer :: Peer
, nodeId :: i
} deriving (Eq, Ord, Show)
sortByDistanceTo :: (Serialize i) => [Node i] -> i -> [Node i]
sortByDistanceTo bucket id = unpack . sort . pack $ bucket
where pack bk = zip bk $ map f bk
f = distance id . nodeId
sort = sortBy (compare `on` snd)
unpack = map fst
class Serialize a where
fromBS :: B.ByteString -> Either String (a, B.ByteString)
toBS :: a -> B.ByteString
type ByteStruct = [Bool]
toByteStruct :: (Serialize a) => a -> ByteStruct
toByteStruct s = B.foldr (\w bits -> convert w ++ bits) [] $ toBS s
where convert w = foldr (\i bits -> testBit w i : bits) [] [0..7]
fromByteStruct :: (Serialize a) => ByteStruct -> a
fromByteStruct bs = case fromBS s of
(Right (converted, _)) -> converted
(Left err) -> error $ "Failed to convert from ByteStruct: " ++ err
where s = B.pack . foldr (\i ws -> createWord i : ws) [] $ indexes
indexes = [0..(length bs `div` 8) 1]
createWord i = let pos = i * 8
in foldr changeBit zeroBits [pos..pos+7]
changeBit i w = if bs !! i
then setBit w (i `mod` 8)
else w
distance :: (Serialize i) => i -> i -> ByteStruct
distance idA idB = let bsA = toByteStruct idA
bsB = toByteStruct idB
in zipWith xor bsA bsB
where xor a b = not (a && b) && (a || b)
toPeer :: SockAddr -> IO (Maybe Peer)
toPeer (SockAddrInet port host) = do
hostname <- inet_ntoa host
return $ Just $ Peer hostname port
toPeer _ = return Nothing
data Signal i v = Signal {
source :: Node i
, command :: Command i v
} deriving (Show, Eq)
data Command i a = PING
| PONG
| STORE i a
| FIND_NODE i
| RETURN_NODES i [Node i]
| FIND_VALUE i
| RETURN_VALUE i a
deriving (Eq, Show)