fix hlint suggestions

[functorrent.git] / src / FuncTorrent / Peer.hs

diff --git a/src/FuncTorrent/Peer.hs b/src/FuncTorrent/Peer.hs
index 2caf377ac6849a79d3e38afe4424d50ee77c32d0..6131a6bb58750d6cf2548c9680b81b822ef5f5ab 100644 (file)
--- a/src/FuncTorrent/Peer.hs
+++ b/src/FuncTorrent/Peer.hs
@@ -60,18 +60,18 @@ initPieceMap pieceHash fileLen pieceLen = fromList kvs
                          , len = pLen })
           | (i, h, pLen) <- zip3 [0..numPieces] hashes pLengths]
     hashes = splitN 20 pieceHash
-    pLengths = (splitNum fileLen pieceLen)
+    pLengths = splitNum fileLen pieceLen
 
 pieceMapFromFile :: FilePath -> PieceMap -> IO PieceMap
-pieceMapFromFile filePath pieceMap = do
+pieceMapFromFile filePath pieceMap =
   traverseWithKey f pieceMap
-    where
-      f k v = do
-        let offset = if k == 0 then 0 else k * len (pieceMap ! (k - 1))
-        isHashValid <- (flip verifyHash) (hash v) <$> (readFileAtOffset filePath offset (len v))
-        if isHashValid
-          then return $ v { dlstate = Have }
-          else return $ v
+  where
+    f k v = do
+      let offset = if k == 0 then 0 else k * len (pieceMap ! (k - 1))
+      isHashValid <- flip verifyHash (hash v) <$> readFileAtOffset filePath offset (len v)
+      if isHashValid
+        then return $ v { dlstate = Have }
+        else return v
 
 havePiece :: PieceMap -> Integer -> Bool
 havePiece pm index =
@@ -84,30 +84,28 @@ connectToPeer (Peer _ ip port) = do
   return h
 
 doHandshake :: Bool -> Handle -> Peer -> ByteString -> String -> IO ()
-doHandshake isClient h peer infoHash peerid =
+doHandshake True h peer infoHash peerid = do
+  let hs = genHandshakeMsg infoHash peerid
+  hPut h hs
+  putStrLn $ "--> handhake to peer: " ++ show peer
+  _ <- hGet h (length (unpack hs))
+  putStrLn $ "<-- handshake from peer: " ++ show peer
+  return ()
+doHandshake False h peer infoHash peerid = do
   let hs = genHandshakeMsg infoHash peerid
-  in
-   if isClient
-   then do
-     hPut h hs
-     putStrLn $ "--> handhake to peer: " ++ show peer
-     _ <- hGet h (length (unpack hs))
-     putStrLn $ "<-- handshake from peer: " ++ show peer
-     return ()
-   else do
-     putStrLn $ "waiting for a handshake"
-     hsMsg <- hGet h (length (unpack hs))
-     putStrLn $ "<-- handshake from peer: " ++ show peer
-     let rxInfoHash = take 20 $ drop 28 hsMsg
-     if rxInfoHash /= infoHash
-       then do
-       putStrLn $ "infoHashes does not match"
-       hClose h
-       return ()
-       else do
-       _ <- hPut h hs
-       putStrLn $ "--> handhake to peer: " ++ show peer
-       return ()
+  putStrLn "waiting for a handshake"
+  hsMsg <- hGet h (length (unpack hs))
+  putStrLn $ "<-- handshake from peer: " ++ show peer
+  let rxInfoHash = take 20 $ drop 28 hsMsg
+  if rxInfoHash /= infoHash
+    then do
+    putStrLn "infoHashes does not match"
+    hClose h
+    return ()
+    else do
+    _ <- hPut h hs
+    putStrLn $ "--> handhake to peer: " ++ show peer
+    return ()
 
 bitfieldToList :: [Word8] -> [Integer]
 bitfieldToList bs = go bs 0
@@ -177,7 +175,7 @@ msgLoop pieceStatus file = do
           pBS <- liftIO $ downloadPiece h workPiece pLen
           if not $ verifyHash pBS (hash (pieceStatus ! workPiece))
             then
-            liftIO $ putStrLn $ "Hash mismatch"
+            liftIO $ putStrLn "Hash mismatch"
             else do
             let fileOffset = if workPiece == 0 then 0 else workPiece * len (pieceStatus ! (workPiece - 1))
             liftIO $ putStrLn $ "Write into file at offset: " ++ show fileOffset
@@ -203,6 +201,21 @@ msgLoop pieceStatus file = do
         UnChokeMsg -> do
           modify (\st -> st {heChoking = False })
           msgLoop pieceStatus file
+        ChokeMsg -> do
+          modify (\st -> st {heChoking = True })
+          msgLoop pieceStatus file
+        InterestedMsg -> do
+          modify (\st -> st {heInterested = True})
+          msgLoop pieceStatus file
+        NotInterestedMsg -> do
+          modify (\st -> st {heInterested = False})
+          msgLoop pieceStatus file
+        CancelMsg _ _ _ -> -- check if valid index, begin, length
+          msgLoop pieceStatus file
+        PortMsg _ ->
+          msgLoop pieceStatus file
+        -- handle RequestMsg, HaveMsg. No need to handle PieceMsg here.
+        -- also BitFieldMsg
 
 
 downloadPiece :: Handle -> Integer -> Integer -> IO ByteString