summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent')
-rw-r--r--src/Network/BitTorrent/DHT/ContactInfo.hs13
-rw-r--r--src/Network/BitTorrent/DHT/Routing.hs11
2 files changed, 13 insertions, 11 deletions
diff --git a/src/Network/BitTorrent/DHT/ContactInfo.hs b/src/Network/BitTorrent/DHT/ContactInfo.hs
index 26bdeae9..f9dae567 100644
--- a/src/Network/BitTorrent/DHT/ContactInfo.hs
+++ b/src/Network/BitTorrent/DHT/ContactInfo.hs
@@ -1,3 +1,4 @@
1{-# LANGUAGE BangPatterns #-}
1module Network.BitTorrent.DHT.ContactInfo 2module Network.BitTorrent.DHT.ContactInfo
2 ( PeerStore 3 ( PeerStore
3 , Network.BitTorrent.DHT.ContactInfo.lookup 4 , Network.BitTorrent.DHT.ContactInfo.lookup
@@ -120,8 +121,8 @@ newtype PeerStore ip = PeerStore (HashMap InfoHash (SwarmData ip))
120type Timestamp = POSIXTime 121type Timestamp = POSIXTime
121 122
122data SwarmData ip = SwarmData 123data SwarmData ip = SwarmData
123 { peers :: PSQ (PeerAddr ip) Timestamp 124 { peers :: !(PSQ (PeerAddr ip) Timestamp)
124 , name :: Maybe ByteString 125 , name :: !(Maybe ByteString)
125 } 126 }
126 127
127 128
@@ -210,16 +211,16 @@ freshPeers ih tm (PeerStore m) = fromMaybe ([],PeerStore m) $ do
210 _ -> peers swarm 211 _ -> peers swarm
211 ps = L.map (key . fst) ps0 212 ps = L.map (key . fst) ps0
212 m' = HM.insert ih swarm { peers = L.foldl' (\q p -> PSQ.insert p tm q) peers' ps } m 213 m' = HM.insert ih swarm { peers = L.foldl' (\q p -> PSQ.insert p tm q) peers' ps } m
213 return (ps,PeerStore m') 214 return $! (ps,PeerStore m')
214 215
215incomp :: (x -> Maybe (r,x)) -> x -> Maybe ((r,x),x) 216incomp :: (x -> Maybe (r,x)) -> x -> Maybe ((r,x),x)
216incomp f x = do 217incomp !f !x = do
217 (result,x') <- f x 218 (result,x') <- f x
218 pure $ ( (result,x'), x' ) 219 pure $! ( (result,x'), x' )
219 220
220-- | Used in 'announce_peer' DHT queries. 221-- | Used in 'announce_peer' DHT queries.
221insertPeer :: Ord a => InfoHash -> Maybe ByteString -> PeerAddr a -> PeerStore a -> PeerStore a 222insertPeer :: Ord a => InfoHash -> Maybe ByteString -> PeerAddr a -> PeerStore a -> PeerStore a
222insertPeer ih name a (PeerStore m) = PeerStore (HM.insertWith swarmInsert ih a' m) 223insertPeer !ih !name !a !(PeerStore m) = seq a' $ PeerStore (HM.insertWith swarmInsert ih a' m)
223 where 224 where
224 a' = SwarmData { peers = PSQ.singleton a 0 225 a' = SwarmData { peers = PSQ.singleton a 0
225 , name = name } 226 , name = name }
diff --git a/src/Network/BitTorrent/DHT/Routing.hs b/src/Network/BitTorrent/DHT/Routing.hs
index 3c2e30aa..5c9788dc 100644
--- a/src/Network/BitTorrent/DHT/Routing.hs
+++ b/src/Network/BitTorrent/DHT/Routing.hs
@@ -14,6 +14,7 @@
14-- <http://www.bittorrent.org/beps/bep_0005.html#routing-table> 14-- <http://www.bittorrent.org/beps/bep_0005.html#routing-table>
15-- 15--
16{-# LANGUAGE RecordWildCards #-} 16{-# LANGUAGE RecordWildCards #-}
17{-# LANGUAGE BangPatterns #-}
17{-# LANGUAGE ViewPatterns #-} 18{-# LANGUAGE ViewPatterns #-}
18{-# LANGUAGE TypeOperators #-} 19{-# LANGUAGE TypeOperators #-}
19{-# LANGUAGE DeriveGeneric #-} 20{-# LANGUAGE DeriveGeneric #-}
@@ -231,8 +232,8 @@ bucketQ = seqQ
231-- very unlikely that all nodes in bucket fail within an hour of 232-- very unlikely that all nodes in bucket fail within an hour of
232-- each other. 233-- each other.
233-- 234--
234data Bucket ip = Bucket { bktNodes :: PSQ (NodeInfo ip) Timestamp 235data Bucket ip = Bucket { bktNodes :: !(PSQ (NodeInfo ip) Timestamp)
235 , bktQ :: BucketQueue ip 236 , bktQ :: !(BucketQueue ip)
236 } deriving (Show,Generic) 237 } deriving (Show,Generic)
237 238
238instance (Eq ip, Serialize ip) => Serialize (Bucket ip) where 239instance (Eq ip, Serialize ip) => Serialize (Bucket ip) where
@@ -531,13 +532,13 @@ modifyBucket
531modifyBucket nodeId f = go (0 :: BitIx) 532modifyBucket nodeId f = go (0 :: BitIx)
532 where 533 where
533 go :: BitIx -> Table ip -> Maybe (xs, Table ip) 534 go :: BitIx -> Table ip -> Maybe (xs, Table ip)
534 go i (Zero table bucket) 535 go !i (Zero table bucket)
535 | testIdBit nodeId i = second (Zero table) <$> f bucket 536 | testIdBit nodeId i = second (Zero table) <$> f bucket
536 | otherwise = second (`Zero` bucket) <$> go (succ i) table 537 | otherwise = second (`Zero` bucket) <$> go (succ i) table
537 go i (One bucket table ) 538 go !i (One bucket table )
538 | testIdBit nodeId i = second (One bucket) <$> go (succ i) table 539 | testIdBit nodeId i = second (One bucket) <$> go (succ i) table
539 | otherwise = second (`One` table) <$> f bucket 540 | otherwise = second (`One` table) <$> f bucket
540 go i (Tip nid n bucket) 541 go !i (Tip nid n bucket)
541 | n == 0 = second (Tip nid n) <$> f bucket 542 | n == 0 = second (Tip nid n) <$> f bucket
542 | otherwise = second (Tip nid n) <$> f bucket 543 | otherwise = second (Tip nid n) <$> f bucket
543 <|> go i (splitTip nid n i bucket) 544 <|> go i (splitTip nid n i bucket)