summaryrefslogtreecommitdiff
path: root/src/Network/DHT
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2017-06-12 21:49:13 -0400
committerjoe <joe@jerkface.net>2017-06-12 21:49:13 -0400
commitab1aaab49ab6a4a13c4416201b261a69155f2eec (patch)
treea12a93b606ec0fb779b7b776b88485470ee95023 /src/Network/DHT
parentdb2e00b691058cade0af2588e82a8f1c1dc857ac (diff)
Evacuated the Network.DHT.Mainline code.
Most of it went to Network.BitTorrent.DHT.Message. Some of it went to Network.DatagramServer.Mainline.
Diffstat (limited to 'src/Network/DHT')
-rw-r--r--src/Network/DHT/Mainline.hs83
1 files changed, 0 insertions, 83 deletions
diff --git a/src/Network/DHT/Mainline.hs b/src/Network/DHT/Mainline.hs
deleted file mode 100644
index 2ecb9845..00000000
--- a/src/Network/DHT/Mainline.hs
+++ /dev/null
@@ -1,83 +0,0 @@
1{-# LANGUAGE LambdaCase #-}
2{-# LANGUAGE MultiParamTypeClasses #-}
3{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE DeriveDataTypeable #-}
5{-# LANGUAGE TypeFamilies #-}
6{-# LANGUAGE GeneralizedNewtypeDeriving #-}
7module Network.DHT.Mainline where
8
9import Data.Digest.CRC32C
10import Control.Applicative
11import Data.Maybe
12import Data.Monoid
13import Data.Word
14import Data.IP
15import Data.BEncode as BE
16import Data.Bits
17import Data.ByteString (ByteString)
18import Data.ByteString.Base16 as Base16
19import qualified Data.ByteString.Char8 as Char8
20import qualified Data.ByteString as BS
21import qualified Data.ByteString.Lazy as L
22import Data.Default
23import Data.LargeWord
24import Data.Serialize as S
25import Data.String
26import Data.Typeable
27import Network.DatagramServer.Mainline (NodeId(..))
28import Network.DatagramServer.Mainline as KRPC
29import Network.DatagramServer.Types as RPC
30import Text.PrettyPrint as PP hiding ((<>))
31import Text.PrettyPrint.HughesPJClass hiding (($$), (<>))
32
33-- | KRPC 'compact list' compatible encoding: contact information for
34-- nodes is encoded as a 26-byte string. Also known as "Compact node
35-- info" the 20-byte Node ID in network byte order has the compact
36-- IP-address/port info concatenated to the end.
37instance Serialize a => Serialize (NodeInfo KMessageOf a ()) where
38 get = (\a b -> NodeInfo a b ()) <$> get <*> get
39 put NodeInfo {..} = put nodeId >> put nodeAddr
40
41instance Pretty ip => Pretty (NodeInfo KMessageOf ip ()) where
42 pPrint NodeInfo {..} = pPrint nodeId <> "@(" <> pPrint nodeAddr <> ")"
43
44instance Pretty ip => Pretty [NodeInfo KMessageOf ip ()] where
45 pPrint = PP.vcat . PP.punctuate "," . map pPrint
46
47
48-- | Yields all 8 DHT neighborhoods available to you given a particular ip
49-- address.
50bep42s :: Address a => a -> NodeId KMessageOf -> [NodeId KMessageOf]
51bep42s addr (NodeId r) = mapMaybe (bep42 addr) rs
52 where
53 rs = map (NodeId . change3bits r) [0..7]
54
55-- change3bits :: ByteString -> Word8 -> ByteString
56-- change3bits bs n = BS.snoc (BS.init bs) (BS.last bs .&. 0xF8 .|. n)
57
58change3bits :: (Num b, Bits b) => b -> b -> b
59change3bits bs n = (bs .&. complement 7) .|. n
60
61-- | Modifies a purely random 'NodeId' to one that is related to a given
62-- routable address in accordance with BEP 42.
63bep42 :: Address a => a -> NodeId KMessageOf -> Maybe (NodeId KMessageOf)
64bep42 addr (NodeId r)
65 | Just ip <- fmap S.encode (fromAddr addr :: Maybe IPv4)
66 <|> fmap S.encode (fromAddr addr :: Maybe IPv6)
67 = genBucketSample' retr (NodeId $ crc $ applyMask ip) (3,0x07,0)
68 | otherwise
69 = Nothing
70 where
71 ip4mask = "\x03\x0f\x3f\xff" :: ByteString
72 ip6mask = "\x01\x03\x07\x0f\x1f\x3f\x7f\xff" :: ByteString
73 nbhood_select = (fromIntegral r :: Word8) .&. 7
74 retr n = pure $ BS.drop (nodeIdSize - n) $ S.encode r
75 crc = flip shiftL (finiteBitSize (NodeId undefined) - 32) . fromIntegral . crc32c . BS.pack
76 applyMask ip = case BS.zipWith (.&.) msk ip of
77 (b:bs) -> (b .|. shiftL nbhood_select 5) : bs
78 bs -> bs
79 where msk | BS.length ip == 4 = ip4mask
80 | otherwise = ip6mask
81
82
83