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