summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--network-bittorrent.cabal1
-rw-r--r--src/Data/Torrent.hs93
-rw-r--r--src/Data/Torrent/InfoHash.hs84
-rw-r--r--src/Network/BitTorrent/PeerWire/Handshake.hs2
-rw-r--r--src/Network/BitTorrent/Tracker/Scrape.hs4
-rw-r--r--tests/info-hash.hs4
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
23library 23library
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
12module Data.Torrent 15module 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
37import Prelude hiding (sum)
38
23import Control.Applicative 39import Control.Applicative
24import Control.Arrow 40import Control.Arrow
41import Data.BEncode as BE
42import Data.Char
43import Data.Foldable
44import Data.Map (Map)
25import qualified Data.Map as M 45import qualified Data.Map as M
26import Data.ByteString (ByteString) 46import Data.ByteString (ByteString)
27import qualified Data.ByteString as B 47import qualified Data.ByteString as B
28import qualified Data.ByteString.Char8 as BC (pack, unpack) 48import qualified Data.ByteString.Char8 as BC (pack, unpack)
49import qualified Data.ByteString.Builder as B
50import qualified Data.ByteString.Builder.Prim as B
51import qualified Data.ByteString.Lazy as Lazy
52import qualified Data.List as L
29import Data.Text (Text) 53import Data.Text (Text)
30import Data.BEncode 54import Data.Serialize as S hiding (Result)
31import Data.Torrent.InfoHash 55import qualified Crypto.Hash.SHA1 as C
32import Network.URI 56import Network.URI
33import System.FilePath 57import System.FilePath
58import Numeric
59
34 60
35type Time = Text 61type 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
267isMultiFile MultiFile {} = True 293isMultiFile MultiFile {} = True
268isMultiFile _ = False 294isMultiFile _ = False
269 295
270
271-- | Read and decode a .torrent file. 296-- | Read and decode a .torrent file.
272fromFile :: FilePath -> IO (Result Torrent) 297fromFile :: FilePath -> IO (Result Torrent)
273fromFile filepath = decoded <$> B.readFile filepath 298fromFile filepath = decoded <$> B.readFile filepath
299
300{-----------------------------------------------------------------------
301 Serialization
302-----------------------------------------------------------------------}
303
304-- | Exactly 20 bytes long SHA1 hash.
305newtype InfoHash = InfoHash { getInfoHash :: ByteString }
306 deriving (Eq, Ord)
307
308instance BEncodable InfoHash where
309 toBEncode = toBEncode . getInfoHash
310
311instance Show InfoHash where
312 show = BC.unpack . ppInfoHash
313
314instance Serialize InfoHash where
315 put = putByteString . getInfoHash
316 get = InfoHash <$> getBytes 20
317
318instance 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
326hash :: ByteString -> InfoHash
327hash = InfoHash . C.hash
328
329hashlazy :: Lazy.ByteString -> InfoHash
330hashlazy = InfoHash . C.hashlazy
331
332ppInfoHash :: InfoHash -> ByteString
333ppInfoHash = Lazy.toStrict . B.toLazyByteString .
334 foldMap (B.primFixed B.word8HexFixed) . B.unpack . getInfoHash
335
336addHashToURI :: URI -> InfoHash -> URI
337addHashToURI 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 #-}
9module Data.Torrent.InfoHash
10 ( InfoHash (getInfoHash)
11 , addHashToURI
12
13 -- * Construction
14 , hash, hashlazy
15
16 -- * Extra
17 , ppHex
18 ) where
19
20import Control.Applicative
21import Data.BEncode
22import Data.Char
23import Data.List as L
24import Data.Foldable
25import Data.Map (Map)
26import qualified Data.Map as M
27import Data.ByteString (ByteString)
28import qualified Data.ByteString as B
29import qualified Data.ByteString.Char8 as BC
30import qualified Data.ByteString.Builder as B
31import qualified Data.ByteString.Builder.Prim as B
32import qualified Data.ByteString.Lazy as Lazy
33import Data.Serialize
34import qualified Crypto.Hash.SHA1 as C
35import Network.URI
36import Numeric
37
38
39-- | Exactly 20 bytes long SHA1 hash.
40newtype InfoHash = InfoHash { getInfoHash :: ByteString }
41 deriving (Eq, Ord, BEncodable)
42
43instance Show InfoHash where
44 show = BC.unpack . ppHex
45
46instance Serialize InfoHash where
47 put = putByteString . getInfoHash
48 get = InfoHash <$> getBytes 20
49
50instance 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
58hash :: ByteString -> InfoHash
59hash = InfoHash . C.hash
60
61hashlazy :: Lazy.ByteString -> InfoHash
62hashlazy = InfoHash . C.hashlazy
63
64ppHex :: InfoHash -> ByteString
65ppHex = Lazy.toStrict . B.toLazyByteString .
66 foldMap (B.primFixed B.word8HexFixed) . B.unpack . getInfoHash
67
68addHashToURI :: URI -> InfoHash -> URI
69addHashToURI 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)
27import qualified Data.ByteString as B 27import qualified Data.ByteString as B
28import qualified Data.ByteString.Char8 as BC 28import qualified Data.ByteString.Char8 as BC
29import Data.Serialize as S 29import Data.Serialize as S
30import Data.Torrent.InfoHash
31import Network 30import Network
32import Network.Socket.ByteString 31import Network.Socket.ByteString
33 32
33import Data.Torrent
34import Network.BitTorrent.Extension 34import Network.BitTorrent.Extension
35import Network.BitTorrent.Peer.ID 35import Network.BitTorrent.Peer.ID
36import Network.BitTorrent.Peer.ClientInfo 36import 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
28import Data.Map (Map) 28import Data.Map (Map)
29import qualified Data.Map as M 29import qualified Data.Map as M
30import Data.Monoid 30import Data.Monoid
31import Data.Torrent.InfoHash
32import Network.URI 31import Network.URI
33import Network.HTTP 32import Network.HTTP
34 33
34import Data.Torrent
35
36
35-- | Information about particular torrent. 37-- | Information about particular torrent.
36data ScrapeInfo = ScrapeInfo { 38data 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