/NodeId.hs

 1module NodeId where
 2
 3import Control.Monad
 4import qualified Data.ByteString as W8
 5import qualified Data.ByteString.Lazy as LW8
 6import GHC.Word
 7import Numeric (showHex, readHex)
 8import Data.Bits
 9import System.Random
10import Control.DeepSeq
11
12import IntBuf
13
14
15newtype NodeId = NodeId W8.ByteString
16    deriving (Eq, Ord)
17
18instance Show NodeId where
19    show (NodeId b) = pad 40 $ showHex (bufToInteger b) ""
20        where pad len s | length s < len = pad len $ '0':s
21                        | otherwise = s
22
23instance NFData NodeId where
24    rnf (NodeId bs) = bs `seq` ()
25
26class NodeIdSource a where
27    makeNodeId :: a -> NodeId
28instance NodeIdSource W8.ByteString where
29    makeNodeId = NodeId
30instance NodeIdSource LW8.ByteString where
31    makeNodeId = fNodeId . W8.concat . LW8.toChunks
32        where fNodeId buf = buf `seq` NodeId buf
33
34makeRandomNodeId :: IO NodeId
35makeRandomNodeId = (NodeId .
36                    W8.pack .
37                    take 20 .
38                    map fromInteger .
39                    randomRs (0, 255)) `liftM` newStdGen
40
41makeRandomNeighbor :: NodeId -> IO NodeId
42makeRandomNeighbor (NodeId nodeIdBuf)
43    = do gen <- newStdGen
44         let nodeIdBuf' = fuzz gen nodeIdBuf
45         nodeIdBuf' `seq`
46                    return $ NodeId nodeIdBuf'
47    where fuzz :: RandomGen g => g
48               -> W8.ByteString -> W8.ByteString
49          fuzz g buf
50              = let (i, g') = randomR (10, 19) g
51                    (x, g'') = randomR (0, 255) g
52                in replace buf i (xor $ fromInteger x)
53          replace :: W8.ByteString -> Int
54                  -> (Word8 -> Word8) -> W8.ByteString
55          replace buf i f
56              = let (buf', buf'') = W8.splitAt i buf
57                in case W8.uncons buf'' of
58                     Nothing -> buf
59                     Just (c, buf''') ->
60                         let c' = f c
61                         in W8.concat [buf', W8.singleton c', buf''']
62
63nodeIdToBuf :: NodeId -> LW8.ByteString
64nodeIdToBuf (NodeId bs) = LW8.fromChunks [bs]
65
66distance :: NodeId -> NodeId -> Integer
67distance (NodeId a) (NodeId b)
68    = bufToInteger $ W8.pack $ W8.zipWith xor a b
69
70(<->) :: NodeId -> NodeId -> Integer
71(<->) = distance
72
73distanceOrder :: NodeId -> NodeId -> Int
74distanceOrder a b = let r 0 = 0
75                        r n = 1 + r (n `shiftR` 1)
76                    in r $ distance a b
77
78nodeIdPlus :: NodeId -> Integer -> NodeId
79nodeIdPlus (NodeId buf) off = NodeId $ integerToBuf $ bufToInteger buf + off
80
81
82hexToNodeId :: String -> Maybe NodeId
83hexToNodeId s
84    | length s == 40 = Just $ NodeId $
85                       W8.pack $
86                       map hexToByte $
87                       chunkify 2 s
88    | otherwise = Nothing
89    where hexToByte s' = let [(i, "")] = readHex s'
90                         in i
91          chunkify size s'
92              | length s' < size = []
93              | otherwise = let (x, xs) = splitAt size s'
94                            in x : chunkify size xs