diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Network/BitTorrent/Exchange/Message.hs | 17 | ||||
-rw-r--r-- | src/Network/BitTorrent/Exchange/Wire.hs | 41 |
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 | ||
88 | import Control.Applicative | 90 | import Control.Applicative |
@@ -859,13 +861,18 @@ instance PeerMessage ExtendedMetadata where | |||
859 | metadataPieceSize :: Int | 861 | metadataPieceSize :: Int |
860 | metadataPieceSize = 16 * 1024 | 862 | metadataPieceSize = 16 * 1024 |
861 | 863 | ||
864 | isLastPiece :: P.Piece a -> Int -> Bool | ||
865 | isLastPiece 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. |
864 | isLastMetadata :: ExtendedMetadata -> Bool | 872 | isValidPiece :: P.Piece BL.ByteString -> Int -> Bool |
865 | isLastMetadata = undefined -- FIXME | 873 | isValidPiece p @ P.Piece {..} total |
866 | 874 | | isLastPiece p total = P.pieceSize p <= metadataPieceSize | |
867 | checkPiece :: ExtendedMetadata -> Bool | 875 | | otherwise = P.pieceSize p == metadataPieceSize |
868 | checkPiece = undefined -- FIXME | ||
869 | 876 | ||
870 | setMetadataPayload :: BS.ByteString -> ExtendedMetadata -> ExtendedMetadata | 877 | setMetadataPayload :: BS.ByteString -> ExtendedMetadata -> ExtendedMetadata |
871 | setMetadataPayload bs (MetadataData (P.Piece pix _) t) = | 878 | setMetadataPayload 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 | ||
60 | import Control.Applicative | 61 | import Control.Applicative |
@@ -689,3 +690,43 @@ acceptWire :: Socket -> PeerAddr IP -> Wire () -> IO () | |||
689 | acceptWire sock peerAddr wire = do | 690 | acceptWire 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 | |||
699 | fetchMetadata :: Wire [BS.ByteString] | ||
700 | fetchMetadata = 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 | |||
724 | getMetadata :: Wire InfoDict | ||
725 | getMetadata = 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 | ||