diff options
-rw-r--r-- | network-bittorrent.cabal | 1 | ||||
-rw-r--r-- | src/Data/Torrent.hs | 93 | ||||
-rw-r--r-- | src/Data/Torrent/InfoHash.hs | 84 | ||||
-rw-r--r-- | src/Network/BitTorrent/PeerWire/Handshake.hs | 2 | ||||
-rw-r--r-- | src/Network/BitTorrent/Tracker/Scrape.hs | 4 | ||||
-rw-r--r-- | tests/info-hash.hs | 4 |
6 files changed, 92 insertions, 96 deletions
diff --git a/network-bittorrent.cabal b/network-bittorrent.cabal index 11d371e6..44dee474 100644 --- a/network-bittorrent.cabal +++ b/network-bittorrent.cabal | |||
@@ -22,7 +22,6 @@ source-repository head | |||
22 | 22 | ||
23 | library | 23 | library |
24 | exposed-modules: Data.Torrent | 24 | exposed-modules: Data.Torrent |
25 | , Data.Torrent.InfoHash | ||
26 | , Data.Bitfield | 25 | , Data.Bitfield |
27 | 26 | ||
28 | , Network.BitTorrent | 27 | , Network.BitTorrent |
diff --git a/src/Data/Torrent.hs b/src/Data/Torrent.hs index 873d90dd..3d5f669e 100644 --- a/src/Data/Torrent.hs +++ b/src/Data/Torrent.hs | |||
@@ -6,31 +6,57 @@ | |||
6 | -- Portability : portable | 6 | -- Portability : portable |
7 | -- | 7 | -- |
8 | -- This module provides torrent metainfo serialization. | 8 | -- This module provides torrent metainfo serialization. |
9 | -- | ||
9 | {-# OPTIONS -fno-warn-orphans #-} | 10 | {-# OPTIONS -fno-warn-orphans #-} |
11 | {-# LANGUAGE FlexibleInstances #-} | ||
10 | {-# LANGUAGE OverloadedStrings #-} | 12 | {-# LANGUAGE OverloadedStrings #-} |
11 | {-# LANGUAGE RecordWildCards #-} | 13 | {-# LANGUAGE RecordWildCards #-} |
14 | -- TODO refine interface | ||
12 | module Data.Torrent | 15 | module Data.Torrent |
13 | ( module Data.Torrent.InfoHash | 16 | ( -- * Torrent |
14 | , Torrent(..), ContentInfo(..), FileInfo(..) | 17 | Torrent(..), ContentInfo(..), FileInfo(..) |
15 | , contentLength, pieceCount, blockCount | 18 | , contentLength, pieceCount, blockCount |
19 | , fromFile | ||
20 | |||
21 | -- * Files layout | ||
16 | , Layout, contentLayout | 22 | , Layout, contentLayout |
17 | , isSingleFile, isMultiFile | 23 | , isSingleFile, isMultiFile |
18 | , fromFile | ||
19 | 24 | ||
25 | -- * Info hash | ||
26 | , InfoHash, ppInfoHash | ||
27 | , hash, hashlazy | ||
28 | , addHashToURI | ||
29 | |||
30 | -- * Extra | ||
20 | , sizeInBase | 31 | , sizeInBase |
32 | |||
33 | -- * Internal | ||
34 | , InfoHash(..) | ||
21 | ) where | 35 | ) where |
22 | 36 | ||
37 | import Prelude hiding (sum) | ||
38 | |||
23 | import Control.Applicative | 39 | import Control.Applicative |
24 | import Control.Arrow | 40 | import Control.Arrow |
41 | import Data.BEncode as BE | ||
42 | import Data.Char | ||
43 | import Data.Foldable | ||
44 | import Data.Map (Map) | ||
25 | import qualified Data.Map as M | 45 | import qualified Data.Map as M |
26 | import Data.ByteString (ByteString) | 46 | import Data.ByteString (ByteString) |
27 | import qualified Data.ByteString as B | 47 | import qualified Data.ByteString as B |
28 | import qualified Data.ByteString.Char8 as BC (pack, unpack) | 48 | import qualified Data.ByteString.Char8 as BC (pack, unpack) |
49 | import qualified Data.ByteString.Builder as B | ||
50 | import qualified Data.ByteString.Builder.Prim as B | ||
51 | import qualified Data.ByteString.Lazy as Lazy | ||
52 | import qualified Data.List as L | ||
29 | import Data.Text (Text) | 53 | import Data.Text (Text) |
30 | import Data.BEncode | 54 | import Data.Serialize as S hiding (Result) |
31 | import Data.Torrent.InfoHash | 55 | import qualified Crypto.Hash.SHA1 as C |
32 | import Network.URI | 56 | import Network.URI |
33 | import System.FilePath | 57 | import System.FilePath |
58 | import Numeric | ||
59 | |||
34 | 60 | ||
35 | type Time = Text | 61 | type Time = Text |
36 | 62 | ||
@@ -157,7 +183,7 @@ instance BEncodable Torrent where | |||
157 | ] | 183 | ] |
158 | 184 | ||
159 | fromBEncode (BDict d) | Just info <- M.lookup "info" d = | 185 | fromBEncode (BDict d) | Just info <- M.lookup "info" d = |
160 | Torrent <$> pure (hashlazy (encode info)) -- WARN | 186 | Torrent <$> pure (hashlazy (BE.encode info)) -- WARN |
161 | <*> d >-- "announce" | 187 | <*> d >-- "announce" |
162 | <*> d >--? "announce-list" | 188 | <*> d >--? "announce-list" |
163 | <*> d >--? "comment" | 189 | <*> d >--? "comment" |
@@ -267,7 +293,60 @@ isMultiFile :: ContentInfo -> Bool | |||
267 | isMultiFile MultiFile {} = True | 293 | isMultiFile MultiFile {} = True |
268 | isMultiFile _ = False | 294 | isMultiFile _ = False |
269 | 295 | ||
270 | |||
271 | -- | Read and decode a .torrent file. | 296 | -- | Read and decode a .torrent file. |
272 | fromFile :: FilePath -> IO (Result Torrent) | 297 | fromFile :: FilePath -> IO (Result Torrent) |
273 | fromFile filepath = decoded <$> B.readFile filepath | 298 | fromFile filepath = decoded <$> B.readFile filepath |
299 | |||
300 | {----------------------------------------------------------------------- | ||
301 | Serialization | ||
302 | -----------------------------------------------------------------------} | ||
303 | |||
304 | -- | Exactly 20 bytes long SHA1 hash. | ||
305 | newtype InfoHash = InfoHash { getInfoHash :: ByteString } | ||
306 | deriving (Eq, Ord) | ||
307 | |||
308 | instance BEncodable InfoHash where | ||
309 | toBEncode = toBEncode . getInfoHash | ||
310 | |||
311 | instance Show InfoHash where | ||
312 | show = BC.unpack . ppInfoHash | ||
313 | |||
314 | instance Serialize InfoHash where | ||
315 | put = putByteString . getInfoHash | ||
316 | get = InfoHash <$> getBytes 20 | ||
317 | |||
318 | instance BEncodable a => BEncodable (Map InfoHash a) where | ||
319 | {-# SPECIALIZE instance BEncodable a => BEncodable (Map InfoHash a) #-} | ||
320 | fromBEncode b = M.mapKeys InfoHash <$> fromBEncode b | ||
321 | {-# INLINE fromBEncode #-} | ||
322 | |||
323 | toBEncode = toBEncode . M.mapKeys getInfoHash | ||
324 | {-# INLINE toBEncode #-} | ||
325 | |||
326 | hash :: ByteString -> InfoHash | ||
327 | hash = InfoHash . C.hash | ||
328 | |||
329 | hashlazy :: Lazy.ByteString -> InfoHash | ||
330 | hashlazy = InfoHash . C.hashlazy | ||
331 | |||
332 | ppInfoHash :: InfoHash -> ByteString | ||
333 | ppInfoHash = Lazy.toStrict . B.toLazyByteString . | ||
334 | foldMap (B.primFixed B.word8HexFixed) . B.unpack . getInfoHash | ||
335 | |||
336 | addHashToURI :: URI -> InfoHash -> URI | ||
337 | addHashToURI uri s = uri { | ||
338 | uriQuery = uriQuery uri ++ mkPref (uriQuery uri) ++ | ||
339 | "info_hash=" ++ rfc1738Encode (BC.unpack (getInfoHash s)) | ||
340 | } | ||
341 | where | ||
342 | mkPref [] = "?" | ||
343 | mkPref ('?' : _) = "&" | ||
344 | mkPref _ = error "addHashToURI" | ||
345 | |||
346 | rfc1738Encode = L.concatMap (\c -> if unreservedS c then [c] else encodeHex c) | ||
347 | where | ||
348 | unreservedS = (`L.elem` chars) | ||
349 | chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_./" | ||
350 | encodeHex c = '%' : pHex c | ||
351 | pHex c = let p = (showHex . ord $ c) "" | ||
352 | in if L.length p == 1 then '0' : p else p | ||
diff --git a/src/Data/Torrent/InfoHash.hs b/src/Data/Torrent/InfoHash.hs deleted file mode 100644 index 51ce0ecd..00000000 --- a/src/Data/Torrent/InfoHash.hs +++ /dev/null | |||
@@ -1,84 +0,0 @@ | |||
1 | -- | | ||
2 | -- Copyright : (c) Sam T. 2013 | ||
3 | -- License : MIT | ||
4 | -- Maintainer : pxqr.sta@gmail.com | ||
5 | -- Stability : experimental | ||
6 | -- Portability : portable | ||
7 | -- | ||
8 | {-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleInstances #-} | ||
9 | module Data.Torrent.InfoHash | ||
10 | ( InfoHash (getInfoHash) | ||
11 | , addHashToURI | ||
12 | |||
13 | -- * Construction | ||
14 | , hash, hashlazy | ||
15 | |||
16 | -- * Extra | ||
17 | , ppHex | ||
18 | ) where | ||
19 | |||
20 | import Control.Applicative | ||
21 | import Data.BEncode | ||
22 | import Data.Char | ||
23 | import Data.List as L | ||
24 | import Data.Foldable | ||
25 | import Data.Map (Map) | ||
26 | import qualified Data.Map as M | ||
27 | import Data.ByteString (ByteString) | ||
28 | import qualified Data.ByteString as B | ||
29 | import qualified Data.ByteString.Char8 as BC | ||
30 | import qualified Data.ByteString.Builder as B | ||
31 | import qualified Data.ByteString.Builder.Prim as B | ||
32 | import qualified Data.ByteString.Lazy as Lazy | ||
33 | import Data.Serialize | ||
34 | import qualified Crypto.Hash.SHA1 as C | ||
35 | import Network.URI | ||
36 | import Numeric | ||
37 | |||
38 | |||
39 | -- | Exactly 20 bytes long SHA1 hash. | ||
40 | newtype InfoHash = InfoHash { getInfoHash :: ByteString } | ||
41 | deriving (Eq, Ord, BEncodable) | ||
42 | |||
43 | instance Show InfoHash where | ||
44 | show = BC.unpack . ppHex | ||
45 | |||
46 | instance Serialize InfoHash where | ||
47 | put = putByteString . getInfoHash | ||
48 | get = InfoHash <$> getBytes 20 | ||
49 | |||
50 | instance BEncodable a => BEncodable (Map InfoHash a) where | ||
51 | {-# SPECIALIZE instance BEncodable a => BEncodable (Map InfoHash a) #-} | ||
52 | fromBEncode b = M.mapKeys InfoHash <$> fromBEncode b | ||
53 | {-# INLINE fromBEncode #-} | ||
54 | |||
55 | toBEncode = toBEncode . M.mapKeys getInfoHash | ||
56 | {-# INLINE toBEncode #-} | ||
57 | |||
58 | hash :: ByteString -> InfoHash | ||
59 | hash = InfoHash . C.hash | ||
60 | |||
61 | hashlazy :: Lazy.ByteString -> InfoHash | ||
62 | hashlazy = InfoHash . C.hashlazy | ||
63 | |||
64 | ppHex :: InfoHash -> ByteString | ||
65 | ppHex = Lazy.toStrict . B.toLazyByteString . | ||
66 | foldMap (B.primFixed B.word8HexFixed) . B.unpack . getInfoHash | ||
67 | |||
68 | addHashToURI :: URI -> InfoHash -> URI | ||
69 | addHashToURI uri s = uri { | ||
70 | uriQuery = uriQuery uri ++ mkPref (uriQuery uri) ++ | ||
71 | "info_hash=" ++ rfc1738Encode (BC.unpack (getInfoHash s)) | ||
72 | } | ||
73 | where | ||
74 | mkPref [] = "?" | ||
75 | mkPref ('?' : _) = "&" | ||
76 | mkPref _ = error "addHashToURI" | ||
77 | |||
78 | rfc1738Encode = L.concatMap (\c -> if unreservedS c then [c] else encodeHex c) | ||
79 | where | ||
80 | unreservedS = (`L.elem` chars) | ||
81 | chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_./" | ||
82 | encodeHex c = '%' : pHex c | ||
83 | pHex c = let p = (showHex . ord $ c) "" | ||
84 | in if L.length p == 1 then '0' : p else p | ||
diff --git a/src/Network/BitTorrent/PeerWire/Handshake.hs b/src/Network/BitTorrent/PeerWire/Handshake.hs index c4acf5cc..6f4598ae 100644 --- a/src/Network/BitTorrent/PeerWire/Handshake.hs +++ b/src/Network/BitTorrent/PeerWire/Handshake.hs | |||
@@ -27,10 +27,10 @@ import Data.ByteString (ByteString) | |||
27 | import qualified Data.ByteString as B | 27 | import qualified Data.ByteString as B |
28 | import qualified Data.ByteString.Char8 as BC | 28 | import qualified Data.ByteString.Char8 as BC |
29 | import Data.Serialize as S | 29 | import Data.Serialize as S |
30 | import Data.Torrent.InfoHash | ||
31 | import Network | 30 | import Network |
32 | import Network.Socket.ByteString | 31 | import Network.Socket.ByteString |
33 | 32 | ||
33 | import Data.Torrent | ||
34 | import Network.BitTorrent.Extension | 34 | import Network.BitTorrent.Extension |
35 | import Network.BitTorrent.Peer.ID | 35 | import Network.BitTorrent.Peer.ID |
36 | import Network.BitTorrent.Peer.ClientInfo | 36 | import Network.BitTorrent.Peer.ClientInfo |
diff --git a/src/Network/BitTorrent/Tracker/Scrape.hs b/src/Network/BitTorrent/Tracker/Scrape.hs index c3f4ee64..0181cf9f 100644 --- a/src/Network/BitTorrent/Tracker/Scrape.hs +++ b/src/Network/BitTorrent/Tracker/Scrape.hs | |||
@@ -28,10 +28,12 @@ import qualified Data.ByteString.Char8 as BC | |||
28 | import Data.Map (Map) | 28 | import Data.Map (Map) |
29 | import qualified Data.Map as M | 29 | import qualified Data.Map as M |
30 | import Data.Monoid | 30 | import Data.Monoid |
31 | import Data.Torrent.InfoHash | ||
32 | import Network.URI | 31 | import Network.URI |
33 | import Network.HTTP | 32 | import Network.HTTP |
34 | 33 | ||
34 | import Data.Torrent | ||
35 | |||
36 | |||
35 | -- | Information about particular torrent. | 37 | -- | Information about particular torrent. |
36 | data ScrapeInfo = ScrapeInfo { | 38 | data ScrapeInfo = ScrapeInfo { |
37 | siComplete :: Int | 39 | siComplete :: Int |
diff --git a/tests/info-hash.hs b/tests/info-hash.hs index ce8d7db2..290b5063 100644 --- a/tests/info-hash.hs +++ b/tests/info-hash.hs | |||
@@ -23,8 +23,8 @@ main = do | |||
23 | Right t <- fromFile path | 23 | Right t <- fromFile path |
24 | 24 | ||
25 | BC.putStr "info hash: " | 25 | BC.putStr "info hash: " |
26 | BC.putStrLn (ppHex (tInfoHash t)) | 26 | BC.putStrLn (ppInfoHash (tInfoHash t)) |
27 | 27 | ||
28 | let passed = checkInfo == ppHex (tInfoHash t) | 28 | let passed = checkInfo == ppInfoHash (tInfoHash t) |
29 | print passed | 29 | print passed |
30 | if passed then exitSuccess else exitFailure | 30 | if passed then exitSuccess else exitFailure |