diff options
Diffstat (limited to 'src/Network/BitTorrent/Tracker/RPC')
-rw-r--r-- | src/Network/BitTorrent/Tracker/RPC/UDP.hs | 8 |
1 files changed, 7 insertions, 1 deletions
diff --git a/src/Network/BitTorrent/Tracker/RPC/UDP.hs b/src/Network/BitTorrent/Tracker/RPC/UDP.hs index 6bd22787..15701062 100644 --- a/src/Network/BitTorrent/Tracker/RPC/UDP.hs +++ b/src/Network/BitTorrent/Tracker/RPC/UDP.hs | |||
@@ -363,6 +363,7 @@ isExpired Connection {..} = do | |||
363 | -- Transactions | 363 | -- Transactions |
364 | -----------------------------------------------------------------------} | 364 | -----------------------------------------------------------------------} |
365 | 365 | ||
366 | -- | Generate a new unused transaction id. | ||
366 | allocTransaction :: Manager -> SockAddr -> MVar Response -> IO TransactionId | 367 | allocTransaction :: Manager -> SockAddr -> MVar Response -> IO TransactionId |
367 | allocTransaction Manager {..} addr ares = modifyMVar pendingResps bindId | 368 | allocTransaction Manager {..} addr ares = modifyMVar pendingResps bindId |
368 | where | 369 | where |
@@ -375,6 +376,7 @@ allocTransaction Manager {..} addr ares = modifyMVar pendingResps bindId | |||
375 | insertId tid Nothing = Just (M.singleton tid ares) | 376 | insertId tid Nothing = Just (M.singleton tid ares) |
376 | insertId tid (Just m) = Just (M.insert tid ares m) | 377 | insertId tid (Just m) = Just (M.insert tid ares m) |
377 | 378 | ||
379 | -- | Wake up blocked thread and return response back. | ||
378 | commitTransaction :: Manager -> SockAddr -> TransactionId -> Response -> IO () | 380 | commitTransaction :: Manager -> SockAddr -> TransactionId -> Response -> IO () |
379 | commitTransaction Manager {..} addr tid resp = | 381 | commitTransaction Manager {..} addr tid resp = |
380 | modifyMVarMasked_ pendingResps $ \ m -> do | 382 | modifyMVarMasked_ pendingResps $ \ m -> do |
@@ -390,6 +392,7 @@ commitTransaction Manager {..} addr tid resp = | |||
390 | where | 392 | where |
391 | m' = M.delete tid m | 393 | m' = M.delete tid m |
392 | 394 | ||
395 | -- | Abort transaction forcefully. | ||
393 | cancelTransaction :: Manager -> SockAddr -> TransactionId -> IO () | 396 | cancelTransaction :: Manager -> SockAddr -> TransactionId -> IO () |
394 | cancelTransaction Manager {..} addr tid = | 397 | cancelTransaction Manager {..} addr tid = |
395 | modifyMVarMasked_ pendingResps $ \m -> | 398 | modifyMVarMasked_ pendingResps $ \m -> |
@@ -401,14 +404,17 @@ cancelTransaction Manager {..} addr tid = | |||
401 | where | 404 | where |
402 | m' = M.delete tid m | 405 | m' = M.delete tid m |
403 | 406 | ||
407 | -- | Handle responses from trackers. | ||
404 | listen :: Manager -> IO () | 408 | listen :: Manager -> IO () |
405 | listen mgr @ Manager {..} = do | 409 | listen mgr @ Manager {..} = do |
406 | forever $ do | 410 | forever $ do |
407 | (bs, addr) <- BS.recvFrom sock (optMaxPacketSize options) | 411 | (bs, addr) <- BS.recvFrom sock (optMaxPacketSize options) |
408 | case decode bs of | 412 | case decode bs of |
409 | Left _ -> return () | 413 | Left _ -> return () -- parser failed, ignoring |
410 | Right (TransactionR {..}) -> commitTransaction mgr addr transIdR response | 414 | Right (TransactionR {..}) -> commitTransaction mgr addr transIdR response |
411 | 415 | ||
416 | -- | Perform RPC transaction. If the action interrupted transaction | ||
417 | -- will be aborted. | ||
412 | transaction :: Manager -> SockAddr -> Connection -> Request -> IO Response | 418 | transaction :: Manager -> SockAddr -> Connection -> Request -> IO Response |
413 | transaction mgr @ Manager {..} addr conn request = do | 419 | transaction mgr @ Manager {..} addr conn request = do |
414 | ares <- newEmptyMVar | 420 | ares <- newEmptyMVar |