summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorSam Truzjan <pxqr.sta@gmail.com>2014-02-21 23:28:51 +0400
committerSam Truzjan <pxqr.sta@gmail.com>2014-02-21 23:28:51 +0400
commit6110d76b6c9e431dcc5934755e69daaa5b7d4270 (patch)
treed4bd260aba8ffc33121edc23a7bbbf35cf5154e6 /src
parent7ad53d7a8dcdb9486944290d5d9c11259399a3b0 (diff)
Code deduplication
Diffstat (limited to 'src')
-rw-r--r--src/Network/BitTorrent/Tracker/RPC/UDP.hs46
1 files changed, 25 insertions, 21 deletions
diff --git a/src/Network/BitTorrent/Tracker/RPC/UDP.hs b/src/Network/BitTorrent/Tracker/RPC/UDP.hs
index 15701062..0e592398 100644
--- a/src/Network/BitTorrent/Tracker/RPC/UDP.hs
+++ b/src/Network/BitTorrent/Tracker/RPC/UDP.hs
@@ -93,14 +93,16 @@ instance Default Options where
93-- Manager state 93-- Manager state
94-----------------------------------------------------------------------} 94-----------------------------------------------------------------------}
95 95
96type ConnectionCache = Map SockAddr Connection
96type PendingTransactions = Map TransactionId (MVar Response) 97type PendingTransactions = Map TransactionId (MVar Response)
98type PendingQueries = Map SockAddr PendingTransactions
97 99
98data Manager = Manager 100data Manager = Manager
99 { options :: !Options 101 { options :: !Options
100 , sock :: !Socket 102 , sock :: !Socket
101-- , dnsCache :: !(IORef (Map URI SockAddr)) 103-- , dnsCache :: !(IORef (Map URI SockAddr))
102 , connectionCache :: !(IORef (Map SockAddr Connection)) 104 , connectionCache :: !(IORef ConnectionCache)
103 , pendingResps :: !(MVar (Map SockAddr PendingTransactions)) 105 , pendingResps :: !(MVar PendingQueries)
104 , listenerThread :: !(MVar ThreadId) 106 , listenerThread :: !(MVar ThreadId)
105 } 107 }
106 108
@@ -363,6 +365,23 @@ isExpired Connection {..} = do
363-- Transactions 365-- Transactions
364-----------------------------------------------------------------------} 366-----------------------------------------------------------------------}
365 367
368register :: SockAddr -> TransactionId -> MVar Response
369 -> PendingQueries -> PendingQueries
370register addr tid ares = M.alter insertId addr
371 where
372 insertId Nothing = Just (M.singleton tid ares)
373 insertId (Just m) = Just (M.insert tid ares m)
374
375unregister :: SockAddr -> TransactionId
376 -> PendingQueries -> PendingQueries
377unregister addr tid = M.update deleteId addr
378 where
379 deleteId m
380 | M.null m' = Nothing
381 | otherwise = Just m'
382 where
383 m' = M.delete tid m
384
366-- | Generate a new unused transaction id. 385-- | Generate a new unused transaction id.
367allocTransaction :: Manager -> SockAddr -> MVar Response -> IO TransactionId 386allocTransaction :: Manager -> SockAddr -> MVar Response -> IO TransactionId
368allocTransaction Manager {..} addr ares = modifyMVar pendingResps bindId 387allocTransaction Manager {..} addr ares = modifyMVar pendingResps bindId
@@ -371,10 +390,7 @@ allocTransaction Manager {..} addr ares = modifyMVar pendingResps bindId
371 tid <- genTransactionId 390 tid <- genTransactionId
372 case M.lookup tid =<< M.lookup addr m of 391 case M.lookup tid =<< M.lookup addr m of
373 Just _ -> bindId m -- already used, retry 392 Just _ -> bindId m -- already used, retry
374 Nothing -> return (M.alter (insertId tid) addr m, tid) 393 Nothing -> return (register addr tid ares m, tid)
375
376 insertId tid Nothing = Just (M.singleton tid ares)
377 insertId tid (Just m) = Just (M.insert tid ares m)
378 394
379-- | Wake up blocked thread and return response back. 395-- | Wake up blocked thread and return response back.
380commitTransaction :: Manager -> SockAddr -> TransactionId -> Response -> IO () 396commitTransaction :: Manager -> SockAddr -> TransactionId -> Response -> IO ()
@@ -384,25 +400,13 @@ commitTransaction Manager {..} addr tid resp =
384 Nothing -> return m -- tracker responded after 'cancelTransaction' fired 400 Nothing -> return m -- tracker responded after 'cancelTransaction' fired
385 Just ares -> do 401 Just ares -> do
386 putMVar ares resp 402 putMVar ares resp
387 return $ M.update deleteId addr m 403 return $ unregister addr tid m
388 where
389 deleteId m
390 | M.null m' = Nothing
391 | otherwise = Just m'
392 where
393 m' = M.delete tid m
394 404
395-- | Abort transaction forcefully. 405-- | Abort transaction forcefully.
396cancelTransaction :: Manager -> SockAddr -> TransactionId -> IO () 406cancelTransaction :: Manager -> SockAddr -> TransactionId -> IO ()
397cancelTransaction Manager {..} addr tid = 407cancelTransaction Manager {..} addr tid =
398 modifyMVarMasked_ pendingResps $ \m -> 408 modifyMVarMasked_ pendingResps $ \m ->
399 return $ M.update deleteId addr m 409 return $ unregister addr tid m
400 where
401 deleteId m
402 | M.null m' = Nothing
403 | otherwise = Just m'
404 where
405 m' = M.delete tid m
406 410
407-- | Handle responses from trackers. 411-- | Handle responses from trackers.
408listen :: Manager -> IO () 412listen :: Manager -> IO ()