]> git.rkrishnan.org Git - functorrent.git/blobdiff - src/FuncTorrent/PeerMsgs.hs
more hlint fixes
[functorrent.git] / src / FuncTorrent / PeerMsgs.hs
index 89744d4c83392a546e84d8c7ad01de5804cdd236..f597ed8c6ee676b3581b25e96a264d7fa35c2fd4 100644 (file)
@@ -1,28 +1,30 @@
-{-# LANGUAGE OverloadedStrings #-}
 {-
-Copyright (C) 2015-2016 Ramakrishnan Muthukrishnan <ram@rkrishnan.org>
-
-This file is part of FuncTorrent.
-
-FuncTorrent is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 3 of the License, or
-(at your option) any later version.
-
-FuncTorrent is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-GNU General Public License for more details.
+ - Copyright (C) 2015-2016 Ramakrishnan Muthukrishnan <ram@rkrishnan.org>
+ -
+ - This file is part of FuncTorrent.
+ -
+ - FuncTorrent is free software; you can redistribute it and/or modify
+ - it under the terms of the GNU General Public License as published by
+ - the Free Software Foundation; either version 3 of the License, or
+ - (at your option) any later version.
+ -
+ - FuncTorrent is distributed in the hope that it will be useful,
+ - but WITHOUT ANY WARRANTY; without even the implied warranty of
+ - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ - GNU General Public License for more details.
+ -
+ - You should have received a copy of the GNU General Public License
+ - along with FuncTorrent; if not,  see <http://www.gnu.org/licenses/>
+ -}
 
-You should have received a copy of the GNU General Public License
-along with FuncTorrent; if not,  see <http://www.gnu.org/licenses/>
--}
+{-# LANGUAGE OverloadedStrings #-}
 
 module FuncTorrent.PeerMsgs
        (genHandshakeMsg,
         sendMsg,
         getMsg,
         Peer(..),
+        makePeer,
         PeerMsg(..)
        ) where
 
@@ -31,6 +33,7 @@ import Prelude hiding (lookup, concat, replicate, splitAt, take)
 import System.IO (Handle)
 import Data.ByteString (ByteString, pack, unpack, concat, hGet, hPut, singleton)
 import Data.ByteString.Lazy (fromStrict, fromChunks, toStrict)
+import Data.ByteString.Char8 as BC (splitAt)
 import qualified Data.ByteString.Char8 as BC (replicate, pack)
 import Control.Monad (replicateM, liftM)
 import Control.Applicative (liftA3)
@@ -39,8 +42,10 @@ import Data.Binary (Binary(..), decode, encode)
 import Data.Binary.Put (putWord32be, putWord16be, putWord8)
 import Data.Binary.Get (getWord32be, getWord16be, getWord8, runGet)
 
--- | Peer is a PeerID, IP address, port tuple
-data Peer = Peer ID IP Port
+import FuncTorrent.Utils (toIP, toPort)
+
+-- | Peer is a IP address, port tuple
+data Peer = Peer IP Port
           deriving (Show, Eq)
 
 type ID = String
@@ -81,9 +86,7 @@ instance Binary PeerMsg where
                                           bfListLen = length bfList
              RequestMsg i o l -> do putWord32be 13
                                     putWord8 6
-                                    putWord32be (fromIntegral i)
-                                    putWord32be (fromIntegral o)
-                                    putWord32be (fromIntegral l)
+                                    putIndexOffsetLength i o l
              PieceMsg i o b -> do putWord32be $ fromIntegral (9 + blocklen)
                                   putWord8 7
                                   putWord32be (fromIntegral i)
@@ -93,12 +96,15 @@ instance Binary PeerMsg where
                                           blocklen = length blockList
              CancelMsg i o l -> do putWord32be 13
                                    putWord8 8
-                                   putWord32be (fromIntegral i)
-                                   putWord32be (fromIntegral o)
-                                   putWord32be (fromIntegral l)
+                                   putIndexOffsetLength i o l
              PortMsg p -> do putWord32be 3
                              putWord8 9
                              putWord16be (fromIntegral p)
+    where putIndexOffsetLength i o l = do
+            putWord32be (fromIntegral i)
+            putWord32be (fromIntegral o)
+            putWord32be (fromIntegral l)
+            
   get = do
     l <- getWord32be
     msgid <- getWord8
@@ -107,15 +113,15 @@ instance Binary PeerMsg where
      1 -> return UnChokeMsg
      2 -> return InterestedMsg
      3 -> return NotInterestedMsg
-     4 -> liftM (HaveMsg . fromIntegral) getWord32be
-     5 -> liftM (BitFieldMsg . pack) (replicateM (fromIntegral l - 1) getWord8)
+     4 -> fmap (HaveMsg . fromIntegral) getWord32be
+     5 -> fmap (BitFieldMsg . pack) (replicateM (fromIntegral l - 1) getWord8)
      6 -> liftA3 RequestMsg getInteger getInteger getInteger
        where getInteger = fromIntegral <$> getWord32be
      7 -> liftA3 PieceMsg getInteger getInteger (pack  <$> replicateM (fromIntegral l - 9) getWord8)
        where getInteger = fromIntegral <$> getWord32be
      8 -> liftA3 CancelMsg getInteger getInteger getInteger
        where getInteger = fromIntegral <$> getWord32be
-     9 -> liftM (PortMsg . fromIntegral) getWord16be
+     9 -> fmap (PortMsg . fromIntegral) getWord16be
      _ -> error ("unknown message ID: " ++ show msgid)
 
 getMsg :: Handle -> IO PeerMsg
@@ -141,3 +147,7 @@ genHandshakeMsg infoHash peer_id = concat [pstrlen, pstr, reserved, infoHash, pe
 
 bsToInt :: ByteString -> Int
 bsToInt x = fromIntegral (runGet getWord32be (fromChunks (return x)))
+
+makePeer :: ByteString -> Peer
+makePeer peer = Peer (toIP ip') (toPort port')
+  where (ip', port') = splitAt 4 peer