From c817da1610c3f549b8dcd8ffa0d8671ad0a6773a Mon Sep 17 00:00:00 2001
From: Sam T <sta.cs.vsu@gmail.com>
Date: Sun, 7 Apr 2013 06:12:01 +0400
Subject: rename PWP to PeerWire

---
 bench/serialization.hs          |   2 +-
 network-bittorrent.cabal        |   2 +-
 src/Network/Torrent.hs          |   6 +--
 src/Network/Torrent/PeerWire.hs | 100 ++++++++++++++++++++++++++++++++++++++++
 4 files changed, 105 insertions(+), 5 deletions(-)
 create mode 100644 src/Network/Torrent/PeerWire.hs

diff --git a/bench/serialization.hs b/bench/serialization.hs
index 31b5b0bf..e7770a1c 100644
--- a/bench/serialization.hs
+++ b/bench/serialization.hs
@@ -6,7 +6,7 @@ import Control.DeepSeq
 import Criterion.Main
 import Data.ByteString (ByteString)
 import Data.Serialize
-import Network.Torrent.PWP
+import Network.Torrent
 
 
 instance NFData BlockIx where
diff --git a/network-bittorrent.cabal b/network-bittorrent.cabal
index c8bcb955..4aa6123f 100644
--- a/network-bittorrent.cabal
+++ b/network-bittorrent.cabal
@@ -20,7 +20,7 @@ library
   exposed-modules:     Data.Torrent
                      , Network.Torrent
                      , Network.Torrent.THP
-                     , Network.Torrent.PWP
+                     , Network.Torrent.PeerWire
                      , Network.Torrent.PeerID
                      , Network.Torrent.Handshake
   other-modules:
diff --git a/src/Network/Torrent.hs b/src/Network/Torrent.hs
index c1f659b7..30d19424 100644
--- a/src/Network/Torrent.hs
+++ b/src/Network/Torrent.hs
@@ -1,11 +1,11 @@
 module Network.Torrent
        ( module Network.Torrent.PeerID
        , module Network.Torrent.THP
+       , module Network.Torrent.PeerWire
        , module Network.Torrent.Handshake
-       , module Network.Torrent.PWP
        ) where
 
-import Network.Torrent.PWP
+import Network.Torrent.PeerID
 import Network.Torrent.THP
+import Network.Torrent.PeerWire
 import Network.Torrent.Handshake
-import Network.Torrent.PeerID
\ No newline at end of file
diff --git a/src/Network/Torrent/PeerWire.hs b/src/Network/Torrent/PeerWire.hs
new file mode 100644
index 00000000..b1fae9f2
--- /dev/null
+++ b/src/Network/Torrent/PeerWire.hs
@@ -0,0 +1,100 @@
+{-# LANGUAGE DoAndIfThenElse #-}
+module Network.Torrent.PeerWire
+       ( Message(..), Block(..), BlockIx(..),
+       ) where
+
+import Control.Applicative
+import           Data.ByteString (ByteString)
+import qualified Data.ByteString as B
+
+import Data.Serialize
+
+data BlockIx = BlockIx {
+    ixPiece  :: {-# UNPACK #-} !Int -- ^ Zero-based piece index.
+  , ixOffset :: {-# UNPACK #-} !Int -- ^ Zero-based byte offset within the piece.
+  , ixLength :: {-# UNPACK #-} !Int -- ^ Block size starting from offset.
+  } deriving (Show, Eq)
+
+data Block = Block {
+    blkPiece  :: Int -- ^ Zero-based piece index.
+  , blkOffset :: Int -- ^ Zero-based byte offset within the piece.
+  , blkData   :: ByteString          -- ^ Payload.
+  } deriving (Show, Eq)
+
+-- TODO comment message constructors
+data Message = KeepAlive
+             | Choke
+             | Unchoke
+             | Interested
+             | NotInterested
+             | Have     Int
+             | Bitfield ByteString
+             | Request  BlockIx
+             | Piece    Block
+             | Cancel   BlockIx
+             | Port     Int
+               deriving (Show, Eq)
+
+getInt :: Get Int
+getInt = fromIntegral <$> getWord32be
+{-# INLINE getInt #-}
+
+putInt :: Putter Int
+putInt = putWord32be . fromIntegral
+{-# INLINE putInt #-}
+
+instance Serialize BlockIx where
+  {-# SPECIALIZE instance Serialize BlockIx #-}
+  get = BlockIx <$> getInt <*> getInt <*> getInt
+  {-# INLINE get #-}
+
+  put ix = do putInt (ixPiece ix)
+              putInt (ixOffset ix)
+              putInt (ixLength ix)
+  {-# INLINE put #-}
+
+instance Serialize Message where
+  get = do
+    len <- getInt
+    lookAhead $ ensure len
+    if len == 0 then return KeepAlive
+    else do
+        mid <- getWord8
+        case mid of
+          0 -> return Choke
+          1 -> return Unchoke
+          2 -> return Interested
+          3 -> return NotInterested
+          4 -> Have     <$> getInt
+          5 -> Bitfield <$> getBytes (pred len)
+          6 -> Request  <$> get
+          7 -> Piece    <$> getBlock (len - 9)
+          8 -> Cancel   <$> get
+          9 -> (Port . fromIntegral) <$> getWord16be
+          _ -> fail $ "unknown message ID: " ++ show mid
+
+    where
+      getBlock :: Int -> Get Block
+      getBlock len = Block <$> getInt <*> getInt <*> getBytes len
+      {-# INLINE getBlock #-}
+
+  put KeepAlive     = putInt 0
+  put Choke         = putInt 1  >> putWord8 0
+  put Unchoke       = putInt 1  >> putWord8 1
+  put Interested    = putInt 1  >> putWord8 2
+  put NotInterested = putInt 1  >> putWord8 3
+  put (Have i)      = putInt 5  >> putWord8 4 >> putInt i
+  put (Bitfield b)  = putInt l  >> putWord8 5 >> putByteString b
+    where l = succ (B.length b)
+          {-# INLINE l #-}
+  put (Request blk) = putInt 13 >> putWord8 6 >> put blk
+  put (Piece   blk) = putInt l  >> putWord8 7 >> putBlock
+    where l = 9 + B.length (blkData blk)
+          {-# INLINE l #-}
+          putBlock = do putInt (blkPiece blk)
+                        putInt (blkOffset  blk)
+                        putByteString (blkData blk)
+          {-# INLINE putBlock #-}
+
+  put (Cancel  blk) = putInt 13 >> putWord8 8 >> put blk
+  put (Port    p  ) = putInt 3  >> putWord8 9 >> putWord16be (fromIntegral p)
\ No newline at end of file
-- 
cgit v1.2.3