diff options
Diffstat (limited to 'src/Network')
-rw-r--r-- | src/Network/BitTorrent/MainlineDHT.hs | 1 | ||||
-rw-r--r-- | src/Network/Kademlia.hs | 24 | ||||
-rw-r--r-- | src/Network/Tox/DHT/Handlers.hs | 4 | ||||
-rw-r--r-- | src/Network/Tox/DHT/Transport.hs | 28 |
4 files changed, 32 insertions, 25 deletions
diff --git a/src/Network/BitTorrent/MainlineDHT.hs b/src/Network/BitTorrent/MainlineDHT.hs index 9d48c67b..6f03ef60 100644 --- a/src/Network/BitTorrent/MainlineDHT.hs +++ b/src/Network/BitTorrent/MainlineDHT.hs | |||
@@ -557,7 +557,6 @@ newClient swarms addr = do | |||
557 | map_var <- atomically $ newTVar (0, mempty) | 557 | map_var <- atomically $ newTVar (0, mempty) |
558 | let net = onInbound (updateRouting outgoingClient routing) | 558 | let net = onInbound (updateRouting outgoingClient routing) |
559 | $ layerTransport parsePacket encodePacket | 559 | $ layerTransport parsePacket encodePacket |
560 | -- $ addVerbosity | ||
561 | $ udp | 560 | $ udp |
562 | 561 | ||
563 | -- Paranoid: It's safe to define /net/ and /client/ to be mutually | 562 | -- Paranoid: It's safe to define /net/ and /client/ to be mutually |
diff --git a/src/Network/Kademlia.hs b/src/Network/Kademlia.hs index 53c37175..315cc652 100644 --- a/src/Network/Kademlia.hs +++ b/src/Network/Kademlia.hs | |||
@@ -52,15 +52,23 @@ data RoutingTransition ni = RoutingTransition | |||
52 | deriving (Eq,Ord,Show,Read) | 52 | deriving (Eq,Ord,Show,Read) |
53 | 53 | ||
54 | data InsertionReporter ni = InsertionReporter | 54 | data InsertionReporter ni = InsertionReporter |
55 | { -- | Called on every inbound packet. | 55 | { -- | Called on every inbound packet. Accepts: |
56 | -- | ||
57 | -- * Origin of packet. | ||
58 | -- | ||
59 | -- * List of nodes to be pinged as a result. | ||
56 | reportArrival :: POSIXTime | 60 | reportArrival :: POSIXTime |
57 | -> ni -- ^ Origin of packet. | 61 | -> ni |
58 | -> [ni] -- ^ These will be pinged as a result. | 62 | -> [ni] |
59 | -> IO () | 63 | -> IO () |
60 | -- | Called on every ping probe. | 64 | -- | Called on every ping probe. Accepts: |
65 | -- | ||
66 | -- * Who was pinged. | ||
67 | -- | ||
68 | -- * True Bool value if they ponged. | ||
61 | , reportPingResult :: POSIXTime | 69 | , reportPingResult :: POSIXTime |
62 | -> ni -- ^ Who was pinged. | 70 | -> ni |
63 | -> Bool -- ^ True if they ponged. | 71 | -> Bool |
64 | -> IO () | 72 | -> IO () |
65 | } | 73 | } |
66 | 74 | ||
@@ -122,8 +130,8 @@ data Kademlia nid ni = Kademlia (InsertionReporter ni) | |||
122 | -- more easily groked list of transitions. | 130 | -- more easily groked list of transitions. |
123 | transition :: (ni,Maybe (t,ni)) -> [RoutingTransition ni] | 131 | transition :: (ni,Maybe (t,ni)) -> [RoutingTransition ni] |
124 | transition (x,m) = | 132 | transition (x,m) = |
125 | -- | Just _ <- m = Node transition: Accepted --> Stranger | 133 | -- Just _ <- m = Node transition: Accepted --> Stranger |
126 | -- | Nothing <- m = Node transition: Applicant --> Stranger | 134 | -- Nothing <- m = Node transition: Applicant --> Stranger |
127 | RoutingTransition x Stranger | 135 | RoutingTransition x Stranger |
128 | : maybeToList (accepted <$> m) | 136 | : maybeToList (accepted <$> m) |
129 | 137 | ||
diff --git a/src/Network/Tox/DHT/Handlers.hs b/src/Network/Tox/DHT/Handlers.hs index 901da99e..f22f9ffe 100644 --- a/src/Network/Tox/DHT/Handlers.hs +++ b/src/Network/Tox/DHT/Handlers.hs | |||
@@ -127,8 +127,8 @@ newRouting addr crypto update4 update6 = do | |||
127 | let nobkts = R.defaultBucketCount :: Int | 127 | let nobkts = R.defaultBucketCount :: Int |
128 | tbl4 <- newTVar $ R.nullTable (comparing nodeId) (\s -> hashWithSalt s . nodeId) tentative_info4 nobkts | 128 | tbl4 <- newTVar $ R.nullTable (comparing nodeId) (\s -> hashWithSalt s . nodeId) tentative_info4 nobkts |
129 | tbl6 <- newTVar $ R.nullTable (comparing nodeId) (\s -> hashWithSalt s . nodeId) tentative_info6 nobkts | 129 | tbl6 <- newTVar $ R.nullTable (comparing nodeId) (\s -> hashWithSalt s . nodeId) tentative_info6 nobkts |
130 | committee4 <- newTriadCommittee (update4 tbl4) -- $ updateIPVote tbl4 addr4 | 130 | committee4 <- newTriadCommittee (update4 tbl4) -- updateIPVote tbl4 addr4 |
131 | committee6 <- newTriadCommittee (update6 tbl6) -- $ updateIPVote tbl6 addr6 | 131 | committee6 <- newTriadCommittee (update6 tbl6) -- updateIPVote tbl6 addr6 |
132 | sched4 <- newTVar Int.empty | 132 | sched4 <- newTVar Int.empty |
133 | sched6 <- newTVar Int.empty | 133 | sched6 <- newTVar Int.empty |
134 | return $ Routing tentative_info sched4 tbl4 committee4 sched6 tbl6 committee6 | 134 | return $ Routing tentative_info sched4 tbl4 committee4 sched6 tbl6 committee6 |
diff --git a/src/Network/Tox/DHT/Transport.hs b/src/Network/Tox/DHT/Transport.hs index 5a2d8a84..d7f8e0cd 100644 --- a/src/Network/Tox/DHT/Transport.hs +++ b/src/Network/Tox/DHT/Transport.hs | |||
@@ -146,21 +146,21 @@ noReplyAddr saddr = either (error . mappend "noReplyAddr: ") id $ nodeInfo zeroI | |||
146 | 146 | ||
147 | 147 | ||
148 | data DHTRequest | 148 | data DHTRequest |
149 | -- #### NAT ping request | 149 | -- #### NAT ping request |
150 | -- | 150 | -- |
151 | -- Length Contents | 151 | -- Length Contents |
152 | -- :------- :------------------------- | 152 | -- :------- :------------------------- |
153 | -- `1` `uint8_t` (0xfe) | 153 | -- `1` `uint8_t` (0xfe) |
154 | -- `1` `uint8_t` (0x00) | 154 | -- `1` `uint8_t` (0x00) |
155 | -- `8` `uint64_t` random number | 155 | -- `8` `uint64_t` random number |
156 | = NATPing Nonce8 | 156 | = NATPing Nonce8 |
157 | -- #### NAT ping response | 157 | -- #### NAT ping response |
158 | -- | 158 | -- |
159 | -- Length Contents | 159 | -- Length Contents |
160 | -- :------- :----------------------------------------------------------------- | 160 | -- :------- :----------------------------------------------------------------- |
161 | -- `1` `uint8_t` (0xfe) | 161 | -- `1` `uint8_t` (0xfe) |
162 | -- `1` `uint8_t` (0x01) | 162 | -- `1` `uint8_t` (0x01) |
163 | -- `8` `uint64_t` random number (the same that was received in request) | 163 | -- `8` `uint64_t` random number (the same that was received in request) |
164 | | NATPong Nonce8 | 164 | | NATPong Nonce8 |
165 | | DHTPK LongTermKeyWrap | 165 | | DHTPK LongTermKeyWrap |
166 | deriving Show | 166 | deriving Show |