Implement CANCEL message handling

1 files changed, 24 insertions, 23 deletions

diff --git a/src/Network/BitTorrent/Exchange/Session.hs b/src/Network/BitTorrent/Exchange/Session.hs
index dce2572f..565ef7ab 100644
--- a/src/Network/BitTorrent/Exchange/Session.hs
+++ b/src/Network/BitTorrent/Exchange/Session.hs
@@ -128,21 +128,8 @@ readBlock bix @ BlockIx {..} s = do
     else throwIO $ InvalidRequest bix (InvalidSize ixLength)
 -}
 
-handleMessage :: Message -> Wire Session ()
-handleMessage KeepAlive       = return ()
-handleMessage (Status s)      = undefined
-handleMessage (Available msg) = do
-  thisBf <- getThisBitfield
-  case msg of
-    Have     ix
-      | ix `BF.member`     thisBf -> return ()
-      |     otherwise             -> undefined
-    Bitfield bf
-      | bf `BF.isSubsetOf` thisBf -> return ()
-      |     otherwise             -> undefined
-
-handleMessage (Transfer  msg) = case msg of
-  Request bix -> do
+handleTransfer :: Transfer -> Wire Session ()
+handleTransfer (Request bix) = do
 --    Session {..} <- getSession
 --    addr <- getRemoteAddr
 --    when (addr `elem` unchoked && ixPiece bix `BF.member` bitfield) $ do
@@ -150,7 +137,7 @@ handleMessage (Transfer  msg) = case msg of
 --      sendMsg (Piece blk)
     return ()
 
-  Piece   blk -> do
+handleTransfer (Piece   blk) = do
 {-
     Session {..} <- getSession
     when (blockIx blk `PS.member` pendingSet) $ do
@@ -160,14 +147,28 @@ handleMessage (Transfer  msg) = case msg of
 -}
     return ()
 
-  Cancel  bix -> filterQueue (not . (transferResponse bix))
-    where
-      transferResponse bix (Transfer (Piece blk)) = blockIx blk == bix
-      transferResponse _    _                     = False
+handleTransfer (Cancel  bix) = filterQueue (not . (transferResponse bix))
+  where
+    transferResponse bix (Transfer (Piece blk)) = blockIx blk == bix
+    transferResponse _    _                     = False
+
+handleMessage :: Message -> Wire Session ()
+handleMessage KeepAlive       = return ()
+handleMessage (Status s)      = undefined
+handleMessage (Available msg) = do
+  thisBf <- getThisBitfield
+  case msg of
+    Have     ix
+      | ix `BF.member`     thisBf -> return ()
+      |     otherwise             -> undefined
+    Bitfield bf
+      | bf `BF.isSubsetOf` thisBf -> return ()
+      |     otherwise             -> undefined
 
-handleMessage (Port      n) = undefined
-handleMessage (Fast      _) = undefined
-handleMessage (Extended  _) = undefined
+handleMessage (Transfer  msg) = handleTransfer msg
+handleMessage (Port      n)   = undefined
+handleMessage (Fast      _)   = undefined
+handleMessage (Extended  _)   = undefined
 
 exchange :: Wire Session ()
 exchange = do