From 07a6123d56df03e5d7c40384c87f6c40ae2b5131 Mon Sep 17 00:00:00 2001 From: Sam T Date: Wed, 3 Jul 2013 00:17:16 +0400 Subject: ~ Use lazy bytestring This lead to the following consequences: * we could efficiently read from storage - if block intersects files boundaries then we will "view" the block in the two different bytestrings. To avoid concat we now return lazy bytestring; * we could read block from socket without "concat" - again, for the same reason. The pitfail is that now we have a bit more heap object, but blocks lifetime is very short and this shouldnt play the big difference. The lifetime is either (socket -> storage -> unreachable) or (storage -> socket -> unreachable) unless a lib user keep block for their own purposes. --- examples/Main.hs | 2 +- src/Network/BitTorrent/Exchange/Protocol.hs | 26 +++++++++++++++----------- src/System/Torrent/Storage.hs | 9 ++++----- tests/Main.hs | 3 +++ 4 files changed, 23 insertions(+), 17 deletions(-) diff --git a/examples/Main.hs b/examples/Main.hs index 18cbefe3..edb37975 100644 --- a/examples/Main.hs +++ b/examples/Main.hs @@ -13,7 +13,7 @@ main = do print (contentLayout "./" (tInfo torrent)) - client <- newClient 10 [] + client <- newClient 2 [] swarm <- newLeecher client torrent storage <- swarm `bindTo` "/tmp/" diff --git a/src/Network/BitTorrent/Exchange/Protocol.hs b/src/Network/BitTorrent/Exchange/Protocol.hs index a285f8d2..feccf760 100644 --- a/src/Network/BitTorrent/Exchange/Protocol.hs +++ b/src/Network/BitTorrent/Exchange/Protocol.hs @@ -260,7 +260,7 @@ data Block = Block { , blkOffset :: {-# UNPACK #-} !Int -- | Payload. - , blkData :: !ByteString -- TODO make lazy bytestring + , blkData :: !Lazy.ByteString -- TODO make lazy bytestring } deriving (Show, Eq) -- | Format block in human readable form. Payload is ommitted. @@ -268,7 +268,8 @@ ppBlock :: Block -> Doc ppBlock = ppBlockIx . blockIx blockSize :: Block -> Int -blockSize blk = B.length (blkData blk) +blockSize blk = fromIntegral (Lazy.length (blkData blk)) +{-# INLINE blockSize #-} -- | Widely used semi-official block size. defaultBlockSize :: Int @@ -277,7 +278,9 @@ defaultBlockSize = 16 * 1024 isPiece :: Int -> Block -> Bool isPiece pieceSize (Block i offset bs) = - offset == 0 && B.length bs == pieceSize && i >= 0 + offset == 0 + && fromIntegral (Lazy.length bs) == pieceSize + && i >= 0 {-# INLINE isPiece #-} pieceIx :: Int -> Int -> BlockIx @@ -285,14 +288,14 @@ pieceIx i = BlockIx i 0 {-# INLINE pieceIx #-} blockIx :: Block -> BlockIx -blockIx = BlockIx <$> blkPiece <*> blkOffset <*> B.length . blkData +blockIx = BlockIx <$> blkPiece <*> blkOffset <*> blockSize blockRange :: (Num a, Integral a) => Int -> Block -> (a, a) blockRange pieceSize blk = (offset, offset + len) where offset = fromIntegral pieceSize * fromIntegral (blkPiece blk) + fromIntegral (blkOffset blk) - len = fromIntegral (B.length (blkData blk)) + len = fromIntegral (Lazy.length (blkData blk)) {-# INLINE blockRange #-} {-# SPECIALIZE blockRange :: Int -> Block -> (Int64, Int64) #-} @@ -402,7 +405,7 @@ instance Serialize Message where where getBlock :: Int -> S.Get Block - getBlock len = Block <$> getInt <*> getInt <*> S.getBytes len + getBlock len = Block <$> getInt <*> getInt <*> S.getLazyByteString (fromIntegral len) {-# INLINE getBlock #-} @@ -418,11 +421,11 @@ instance Serialize Message where {-# INLINE l #-} put (Request blk) = putInt 13 >> S.putWord8 0x06 >> S.put blk put (Piece blk) = putInt l >> S.putWord8 0x07 >> putBlock - where l = 9 + B.length (blkData blk) + where l = 9 + fromIntegral (Lazy.length (blkData blk)) {-# INLINE l #-} putBlock = do putInt (blkPiece blk) putInt (blkOffset blk) - S.putByteString (blkData blk) + S.putLazyByteString (blkData blk) {-# INLINE putBlock #-} put (Cancel blk) = putInt 13 >> S.putWord8 0x08 >> S.put blk @@ -463,7 +466,8 @@ instance Binary Message where where getBlock :: Int -> B.Get Block - getBlock len = Block <$> getIntB <*> getIntB <*> B.getByteString len + getBlock len = Block <$> getIntB <*> getIntB + <*> B.getLazyByteString (fromIntegral len) {-# INLINE getBlock #-} put KeepAlive = putIntB 0 @@ -478,11 +482,11 @@ instance Binary Message where {-# INLINE l #-} put (Request blk) = putIntB 13 >> B.putWord8 0x06 >> B.put blk put (Piece blk) = putIntB l >> B.putWord8 0x07 >> putBlock - where l = 9 + B.length (blkData blk) + where l = 9 + fromIntegral (Lazy.length (blkData blk)) {-# INLINE l #-} putBlock = do putIntB (blkPiece blk) putIntB (blkOffset blk) - B.putByteString (blkData blk) + B.putLazyByteString (blkData blk) {-# INLINE putBlock #-} put (Cancel blk) = putIntB 13 >> B.putWord8 0x08 >> B.put blk diff --git a/src/System/Torrent/Storage.hs b/src/System/Torrent/Storage.hs index 955c1746..363f94ef 100644 --- a/src/System/Torrent/Storage.hs +++ b/src/System/Torrent/Storage.hs @@ -143,9 +143,7 @@ putBlk blk @ Block {..} st @ Storage {..} -- let blkIx = undefined -- bm <- readTVarIO blocks -- unless (member blkIx bm) $ do - writeBytes (blkInterval (pieceLength session) blk) - (Lazy.fromChunks [blkData]) - payload + writeBytes (blkInterval (pieceLength session) blk) blkData payload markBlock blk st validatePiece blkPiece st @@ -166,7 +164,7 @@ getBlk ix @ BlockIx {..} st @ Storage {..} = liftIO $ {-# SCC getBlk #-} do -- TODO check if __piece__ is available bs <- readBytes (ixInterval (pieceLength session) ix) payload - return $ Block ixPiece ixOffset (Lazy.toStrict bs) + return $ Block ixPiece ixOffset bs getPiece :: PieceIx -> Storage -> IO ByteString getPiece pix st @ Storage {..} = {-# SCC getPiece #-} do @@ -220,4 +218,5 @@ ixInterval pieceSize BlockIx {..} = blkInterval :: Int -> Block -> FixedInterval blkInterval pieceSize Block {..} = - Fixed.interval (blkPiece * pieceSize + blkOffset) (B.length blkData) \ No newline at end of file + Fixed.interval (blkPiece * pieceSize + blkOffset) + (fromIntegral (Lazy.length blkData)) \ No newline at end of file diff --git a/tests/Main.hs b/tests/Main.hs index b99f2469..45f92813 100644 --- a/tests/Main.hs +++ b/tests/Main.hs @@ -161,6 +161,9 @@ positive = fromIntegral <$> (arbitrary :: Gen Word32) instance Arbitrary ByteString where arbitrary = B.pack <$> arbitrary +instance Arbitrary Lazy.ByteString where + arbitrary = Lazy.pack <$> arbitrary + instance Arbitrary BlockIx where arbitrary = BlockIx <$> positive <*> positive <*> positive -- cgit v1.2.3