summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Network/BitTorrent/Exchange/Message.hs17
-rw-r--r--src/Network/BitTorrent/Exchange/Wire.hs41
2 files changed, 53 insertions, 5 deletions
diff --git a/src/Network/BitTorrent/Exchange/Message.hs b/src/Network/BitTorrent/Exchange/Message.hs
index e93f8bbe..d0d2bb03 100644
--- a/src/Network/BitTorrent/Exchange/Message.hs
+++ b/src/Network/BitTorrent/Exchange/Message.hs
@@ -83,6 +83,8 @@ module Network.BitTorrent.Exchange.Message
83 , metadataPieceSize 83 , metadataPieceSize
84 , defaultMetadataFactor 84 , defaultMetadataFactor
85 , defaultMaxInfoDictSize 85 , defaultMaxInfoDictSize
86 , isLastPiece
87 , isValidPiece
86 ) where 88 ) where
87 89
88import Control.Applicative 90import Control.Applicative
@@ -859,13 +861,18 @@ instance PeerMessage ExtendedMetadata where
859metadataPieceSize :: Int 861metadataPieceSize :: Int
860metadataPieceSize = 16 * 1024 862metadataPieceSize = 16 * 1024
861 863
864isLastPiece :: P.Piece a -> Int -> Bool
865isLastPiece P.Piece {..} total = succ pieceIndex == pcnt
866 where
867 pcnt = q + if r > 0 then 1 else 0
868 (q, r) = quotRem total metadataPieceSize
869
862-- TODO we can check if the piece payload bytestring have appropriate 870-- TODO we can check if the piece payload bytestring have appropriate
863-- length; otherwise serialization MUST fail. 871-- length; otherwise serialization MUST fail.
864isLastMetadata :: ExtendedMetadata -> Bool 872isValidPiece :: P.Piece BL.ByteString -> Int -> Bool
865isLastMetadata = undefined -- FIXME 873isValidPiece p @ P.Piece {..} total
866 874 | isLastPiece p total = P.pieceSize p <= metadataPieceSize
867checkPiece :: ExtendedMetadata -> Bool 875 | otherwise = P.pieceSize p == metadataPieceSize
868checkPiece = undefined -- FIXME
869 876
870setMetadataPayload :: BS.ByteString -> ExtendedMetadata -> ExtendedMetadata 877setMetadataPayload :: BS.ByteString -> ExtendedMetadata -> ExtendedMetadata
871setMetadataPayload bs (MetadataData (P.Piece pix _) t) = 878setMetadataPayload bs (MetadataData (P.Piece pix _) t) =
diff --git a/src/Network/BitTorrent/Exchange/Wire.hs b/src/Network/BitTorrent/Exchange/Wire.hs
index 369f0746..427d7676 100644
--- a/src/Network/BitTorrent/Exchange/Wire.hs
+++ b/src/Network/BitTorrent/Exchange/Wire.hs
@@ -55,6 +55,7 @@ module Network.BitTorrent.Exchange.Wire
55 , getConnection 55 , getConnection
56 , getExtCaps 56 , getExtCaps
57 , getStats 57 , getStats
58 , getMetadata
58 ) where 59 ) where
59 60
60import Control.Applicative 61import Control.Applicative
@@ -689,3 +690,43 @@ acceptWire :: Socket -> PeerAddr IP -> Wire () -> IO ()
689acceptWire sock peerAddr wire = do 690acceptWire sock peerAddr wire = do
690 bracket (return sock) close $ \ _ -> do 691 bracket (return sock) close $ \ _ -> do
691 error "acceptWire: not implemented" 692 error "acceptWire: not implemented"
693
694{-----------------------------------------------------------------------
695-- Metadata exchange
696-----------------------------------------------------------------------}
697-- TODO introduce new metadata exchange specific exceptions
698
699fetchMetadata :: Wire [BS.ByteString]
700fetchMetadata = loop 0
701 where
702 recvData = recvMessage >>= inspect
703 where
704 inspect (Extended (EMetadata _ meta)) =
705 case meta of
706 MetadataRequest pix -> do
707 sendMessage (MetadataReject pix)
708 recvData
709 MetadataData {..} -> return (piece, totalSize)
710 MetadataReject _ -> disconnectPeer
711 MetadataUnknown _ -> recvData
712 inspect _ = recvData
713
714 loop i = do
715 sendMessage (MetadataRequest i)
716 (piece, totalSize) <- recvData
717 unless (pieceIndex piece == i) $ do
718 disconnectPeer
719
720 if piece `isLastPiece` totalSize
721 then pure [pieceData piece]
722 else (pieceData piece :) <$> loop (succ i)
723
724getMetadata :: Wire InfoDict
725getMetadata = do
726 chunks <- fetchMetadata
727 Connection {..} <- getConnection
728 case BE.decode (BS.concat chunks) of
729 Right (infodict @ InfoDict {..})
730 | connTopic == idInfoHash -> return infodict
731 | otherwise -> error "broken infodict"
732 Left err -> error $ "unable to parse infodict" ++ err