diff options
Diffstat (limited to 'Mainline.hs')
-rw-r--r-- | Mainline.hs | 87 |
1 files changed, 58 insertions, 29 deletions
diff --git a/Mainline.hs b/Mainline.hs index b24f847d..30e18a09 100644 --- a/Mainline.hs +++ b/Mainline.hs | |||
@@ -16,65 +16,67 @@ import Control.Arrow | |||
16 | import Control.Concurrent.STM | 16 | import Control.Concurrent.STM |
17 | import Control.Monad | 17 | import Control.Monad |
18 | import Crypto.Random | 18 | import Crypto.Random |
19 | import Data.BEncode as BE | 19 | import Data.BEncode as BE |
20 | import qualified Data.BEncode.BDict as BE | 20 | import qualified Data.BEncode.BDict as BE |
21 | ;import Data.BEncode.BDict (BKey) | 21 | ;import Data.BEncode.BDict (BKey) |
22 | import Data.BEncode.Pretty | 22 | import Data.BEncode.Pretty |
23 | import Data.BEncode.Types (BDict) | 23 | import Data.BEncode.Types (BDict) |
24 | import Data.Bits | 24 | import Data.Bits |
25 | import Data.Bits.ByteString | 25 | import Data.Bits.ByteString |
26 | import Data.Bool | 26 | import Data.Bool |
27 | import qualified Data.ByteArray as BA | 27 | import qualified Data.ByteArray as BA |
28 | ;import Data.ByteArray (ByteArrayAccess) | 28 | ;import Data.ByteArray (ByteArrayAccess) |
29 | import qualified Data.ByteString as B | 29 | import qualified Data.ByteString as B |
30 | ;import Data.ByteString (ByteString) | 30 | ;import Data.ByteString (ByteString) |
31 | import qualified Data.ByteString.Base16 as Base16 | 31 | import qualified Data.ByteString.Base16 as Base16 |
32 | import qualified Data.ByteString.Char8 as Char8 | 32 | import qualified Data.ByteString.Char8 as Char8 |
33 | import Data.ByteString.Lazy (toStrict) | 33 | import Data.ByteString.Lazy (toStrict) |
34 | import qualified Data.ByteString.Lazy.Char8 as L8 | 34 | import qualified Data.ByteString.Lazy.Char8 as L8 |
35 | import Data.Char | ||
35 | import Data.Coerce | 36 | import Data.Coerce |
36 | import Data.Data | 37 | import Data.Data |
37 | import Data.Default | 38 | import Data.Default |
38 | import Data.Digest.CRC32C | 39 | import Data.Digest.CRC32C |
39 | import Data.Function (fix) | 40 | import Data.Function (fix) |
40 | import Data.Hashable | 41 | import Data.Hashable |
41 | import Data.IP | 42 | import Data.IP |
42 | import Data.List | 43 | import Data.List |
43 | import Data.Maybe | 44 | import Data.Maybe |
44 | import Data.Monoid | 45 | import Data.Monoid |
45 | import Data.Ord | 46 | import Data.Ord |
46 | import qualified Data.Serialize as S | 47 | import qualified Data.Serialize as S |
47 | import Data.Set (Set) | 48 | import Data.Set (Set) |
48 | import Data.Time.Clock.POSIX (POSIXTime) | 49 | import Data.Time.Clock.POSIX (POSIXTime) |
49 | import Data.Torrent | 50 | import Data.Torrent |
50 | import Data.Typeable | 51 | import Data.Typeable |
51 | import Data.Word | 52 | import Data.Word |
52 | import qualified Data.Wrapper.PSQInt as Int | 53 | import qualified Data.Wrapper.PSQInt as Int |
53 | import Debug.Trace | 54 | import Debug.Trace |
54 | import Kademlia | 55 | import Kademlia |
55 | import Network.Address (Address, fromAddr, fromSockAddr, | 56 | import Network.Address (Address, fromAddr, fromSockAddr, |
56 | setPort, sockAddrPort, testIdBit, | 57 | setPort, sockAddrPort, testIdBit, |
57 | toSockAddr) | 58 | toSockAddr) |
58 | import Network.BitTorrent.DHT.ContactInfo as Peers | 59 | import Network.BitTorrent.DHT.ContactInfo as Peers |
59 | import Network.BitTorrent.DHT.Search (Search (..)) | 60 | import Network.BitTorrent.DHT.Search (Search (..)) |
60 | import Network.BitTorrent.DHT.Token as Token | 61 | import Network.BitTorrent.DHT.Token as Token |
61 | import Network.DatagramServer.Types (genBucketSample') | 62 | import Network.DatagramServer.Types (genBucketSample') |
62 | import qualified Network.DHT.Routing as R | 63 | import qualified Network.DHT.Routing as R |
63 | ;import Network.DHT.Routing (Info, Timestamp, getTimestamp) | 64 | ;import Network.DHT.Routing (Info, Timestamp, getTimestamp) |
64 | import Network.QueryResponse | 65 | import Network.QueryResponse |
65 | import Network.Socket | 66 | import Network.Socket |
66 | import System.IO | 67 | import System.IO |
67 | import System.IO.Error | 68 | import System.IO.Error |
68 | import System.IO.Unsafe (unsafeInterleaveIO) | 69 | import System.IO.Unsafe (unsafeInterleaveIO) |
70 | import qualified Text.ParserCombinators.ReadP as RP | ||
69 | #ifdef THREAD_DEBUG | 71 | #ifdef THREAD_DEBUG |
70 | import Control.Concurrent.Lifted.Instrument | 72 | import Control.Concurrent.Lifted.Instrument |
71 | #else | 73 | #else |
72 | import Control.Concurrent.Lifted | 74 | import Control.Concurrent.Lifted |
73 | import GHC.Conc (labelThread) | 75 | import GHC.Conc (labelThread) |
74 | #endif | 76 | #endif |
75 | import Control.Exception (SomeException(..),handle) | 77 | import Control.Exception (SomeException (..), handle) |
76 | import Data.Aeson (FromJSON,ToJSON,(.=)) | ||
77 | import qualified Data.Aeson as JSON | 78 | import qualified Data.Aeson as JSON |
79 | ;import Data.Aeson (FromJSON, ToJSON, (.=)) | ||
78 | import Text.Read | 80 | import Text.Read |
79 | 81 | ||
80 | newtype NodeId = NodeId ByteString | 82 | newtype NodeId = NodeId ByteString |
@@ -129,6 +131,33 @@ instance FromJSON NodeInfo where | |||
129 | guard (B.length bs == 20) | 131 | guard (B.length bs == 20) |
130 | return $ NodeInfo (NodeId bs) ip (fromIntegral (portnum :: Word16)) | 132 | return $ NodeInfo (NodeId bs) ip (fromIntegral (portnum :: Word16)) |
131 | 133 | ||
134 | hexdigit :: Char -> Bool | ||
135 | hexdigit c = ('0' <= c && c <= '9') || ( 'a' <= c && c <= 'f') || ( 'A' <= c && c <= 'F') | ||
136 | |||
137 | instance Read NodeInfo where | ||
138 | readsPrec i = RP.readP_to_S $ do | ||
139 | RP.skipSpaces | ||
140 | let n = 40 | ||
141 | hexhash <- sequence $ replicate n (RP.satisfy hexdigit) | ||
142 | RP.char '@' RP.+++ RP.satisfy isSpace | ||
143 | addrstr <- RP.between (RP.char '(') (RP.char ')') (RP.munch (/=')')) | ||
144 | RP.+++ RP.munch (not . isSpace) | ||
145 | let raddr = do | ||
146 | -- TODO: Support IPv6 | ||
147 | ipv4 <- RP.readS_to_P (readsPrec i) | ||
148 | _ <- RP.char ':' | ||
149 | port <- toEnum <$> RP.readS_to_P (readsPrec i) | ||
150 | return (IPv4 ipv4, port) | ||
151 | |||
152 | (ip,port) <- case RP.readP_to_S raddr addrstr of | ||
153 | [] -> fail "Bad address." | ||
154 | ((ip,port),_):_ -> return (ip,port) | ||
155 | nid <- case Base16.decode $ Char8.pack hexhash of | ||
156 | (bs,_) | B.length bs==20 -> return (NodeId bs) | ||
157 | _ -> fail "Bad node id." | ||
158 | return $ NodeInfo nid ip port | ||
159 | |||
160 | |||
132 | 161 | ||
133 | -- The Hashable instance depends only on the IP address and port number. It is | 162 | -- The Hashable instance depends only on the IP address and port number. It is |
134 | -- used to compute the announce token. | 163 | -- used to compute the announce token. |