diff options
author | joe <joe@jerkface.net> | 2017-06-12 21:49:13 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2017-06-12 21:49:13 -0400 |
commit | ab1aaab49ab6a4a13c4416201b261a69155f2eec (patch) | |
tree | a12a93b606ec0fb779b7b776b88485470ee95023 /src/Network/DHT | |
parent | db2e00b691058cade0af2588e82a8f1c1dc857ac (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.hs | 83 |
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 #-} | ||
7 | module Network.DHT.Mainline where | ||
8 | |||
9 | import Data.Digest.CRC32C | ||
10 | import Control.Applicative | ||
11 | import Data.Maybe | ||
12 | import Data.Monoid | ||
13 | import Data.Word | ||
14 | import Data.IP | ||
15 | import Data.BEncode as BE | ||
16 | import Data.Bits | ||
17 | import Data.ByteString (ByteString) | ||
18 | import Data.ByteString.Base16 as Base16 | ||
19 | import qualified Data.ByteString.Char8 as Char8 | ||
20 | import qualified Data.ByteString as BS | ||
21 | import qualified Data.ByteString.Lazy as L | ||
22 | import Data.Default | ||
23 | import Data.LargeWord | ||
24 | import Data.Serialize as S | ||
25 | import Data.String | ||
26 | import Data.Typeable | ||
27 | import Network.DatagramServer.Mainline (NodeId(..)) | ||
28 | import Network.DatagramServer.Mainline as KRPC | ||
29 | import Network.DatagramServer.Types as RPC | ||
30 | import Text.PrettyPrint as PP hiding ((<>)) | ||
31 | import 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. | ||
37 | instance Serialize a => Serialize (NodeInfo KMessageOf a ()) where | ||
38 | get = (\a b -> NodeInfo a b ()) <$> get <*> get | ||
39 | put NodeInfo {..} = put nodeId >> put nodeAddr | ||
40 | |||
41 | instance Pretty ip => Pretty (NodeInfo KMessageOf ip ()) where | ||
42 | pPrint NodeInfo {..} = pPrint nodeId <> "@(" <> pPrint nodeAddr <> ")" | ||
43 | |||
44 | instance 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. | ||
50 | bep42s :: Address a => a -> NodeId KMessageOf -> [NodeId KMessageOf] | ||
51 | bep42s 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 | |||
58 | change3bits :: (Num b, Bits b) => b -> b -> b | ||
59 | change3bits 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. | ||
63 | bep42 :: Address a => a -> NodeId KMessageOf -> Maybe (NodeId KMessageOf) | ||
64 | bep42 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 | |||