/NodeId.hs
Haskell | 94 lines | 78 code | 16 blank | 0 comment | 1 complexity | fe15b372b04fe95ac6360e299ef28b69 MD5 | raw file
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