diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Data/Torrent.hs | 285 |
1 files changed, 148 insertions, 137 deletions
diff --git a/src/Data/Torrent.hs b/src/Data/Torrent.hs index 8e6f9088..19365481 100644 --- a/src/Data/Torrent.hs +++ b/src/Data/Torrent.hs | |||
@@ -17,11 +17,12 @@ | |||
17 | -- <https://wiki.theory.org/BitTorrentSpecification#Metainfo_File_Structure> | 17 | -- <https://wiki.theory.org/BitTorrentSpecification#Metainfo_File_Structure> |
18 | -- | 18 | -- |
19 | {-# OPTIONS -fno-warn-orphans #-} | 19 | {-# OPTIONS -fno-warn-orphans #-} |
20 | {-# LANGUAGE CPP #-} | 20 | {-# LANGUAGE CPP #-} |
21 | {-# LANGUAGE FlexibleInstances #-} | 21 | {-# LANGUAGE FlexibleInstances #-} |
22 | {-# LANGUAGE OverloadedStrings #-} | 22 | {-# LANGUAGE OverloadedStrings #-} |
23 | {-# LANGUAGE RecordWildCards #-} | 23 | {-# LANGUAGE RecordWildCards #-} |
24 | {-# LANGUAGE BangPatterns #-} | 24 | {-# LANGUAGE BangPatterns #-} |
25 | {-# LANGUAGE TemplateHaskell #-} | ||
25 | -- TODO refine interface | 26 | -- TODO refine interface |
26 | module Data.Torrent | 27 | module Data.Torrent |
27 | ( -- * Torrent | 28 | ( -- * Torrent |
@@ -60,6 +61,10 @@ import Prelude hiding (sum) | |||
60 | import Control.Applicative | 61 | import Control.Applicative |
61 | import Control.Arrow | 62 | import Control.Arrow |
62 | import Control.Exception | 63 | import Control.Exception |
64 | |||
65 | import qualified Crypto.Hash.SHA1 as C | ||
66 | |||
67 | import Data.Aeson.TH | ||
63 | import Data.BEncode as BE | 68 | import Data.BEncode as BE |
64 | import Data.Char | 69 | import Data.Char |
65 | import Data.Foldable | 70 | import Data.Foldable |
@@ -67,6 +72,7 @@ import Data.Map (Map) | |||
67 | import qualified Data.Map as M | 72 | import qualified Data.Map as M |
68 | import Data.ByteString (ByteString) | 73 | import Data.ByteString (ByteString) |
69 | import qualified Data.ByteString as B | 74 | import qualified Data.ByteString as B |
75 | import Data.ByteString.Internal | ||
70 | import qualified Data.ByteString.Char8 as BC (pack, unpack) | 76 | import qualified Data.ByteString.Char8 as BC (pack, unpack) |
71 | import qualified Data.ByteString.Lazy as Lazy | 77 | import qualified Data.ByteString.Lazy as Lazy |
72 | import qualified Data.ByteString.Lazy.Builder as B | 78 | import qualified Data.ByteString.Lazy.Builder as B |
@@ -76,17 +82,155 @@ import Data.Hashable as Hashable | |||
76 | import Data.Text (Text) | 82 | import Data.Text (Text) |
77 | import Data.Serialize as S hiding (Result) | 83 | import Data.Serialize as S hiding (Result) |
78 | import Text.PrettyPrint | 84 | import Text.PrettyPrint |
79 | import qualified Crypto.Hash.SHA1 as C | 85 | |
80 | import Network.URI | 86 | import Network.URI |
81 | import System.FilePath | 87 | import System.FilePath |
82 | import Numeric | 88 | import Numeric |
83 | 89 | ||
84 | import Data.ByteString.Internal | ||
85 | import Debug.Trace | 90 | import Debug.Trace |
86 | 91 | ||
92 | {----------------------------------------------------------------------- | ||
93 | Info hash | ||
94 | -----------------------------------------------------------------------} | ||
95 | |||
96 | -- | Exactly 20 bytes long SHA1 hash of the info part of torrent file. | ||
97 | newtype InfoHash = InfoHash { getInfoHash :: ByteString } | ||
98 | deriving (Eq, Ord) | ||
99 | |||
100 | instance Show InfoHash where | ||
101 | show = render . ppInfoHash | ||
102 | |||
103 | instance Hashable InfoHash where | ||
104 | hash = Hashable.hash . getInfoHash | ||
105 | |||
106 | instance BEncodable InfoHash where | ||
107 | toBEncode = toBEncode . getInfoHash | ||
108 | fromBEncode be = InfoHash <$> fromBEncode be | ||
109 | |||
110 | instance Serialize InfoHash where | ||
111 | put = putByteString . getInfoHash | ||
112 | get = InfoHash <$> getBytes 20 | ||
113 | |||
114 | instance BEncodable a => BEncodable (Map InfoHash a) where | ||
115 | {-# SPECIALIZE instance BEncodable a => BEncodable (Map InfoHash a) #-} | ||
116 | fromBEncode b = M.mapKeys InfoHash <$> fromBEncode b | ||
117 | {-# INLINE fromBEncode #-} | ||
118 | |||
119 | toBEncode = toBEncode . M.mapKeys getInfoHash | ||
120 | {-# INLINE toBEncode #-} | ||
121 | |||
122 | -- | Hash strict bytestring using SHA1 algorithm. | ||
123 | hash :: ByteString -> InfoHash | ||
124 | hash = InfoHash . C.hash | ||
125 | |||
126 | -- | Hash lazy bytestring using SHA1 algorithm. | ||
127 | hashlazy :: Lazy.ByteString -> InfoHash | ||
128 | hashlazy = InfoHash . C.hashlazy | ||
129 | |||
130 | -- | Pretty print info hash in hexadecimal format. | ||
131 | ppInfoHash :: InfoHash -> Doc | ||
132 | ppInfoHash = text . BC.unpack . ppHex . getInfoHash | ||
133 | |||
134 | ppHex :: ByteString -> ByteString | ||
135 | ppHex = Lazy.toStrict . B.toLazyByteString . B.byteStringHexFixed | ||
136 | |||
137 | -- | Add query info hash parameter to uri. | ||
138 | -- | ||
139 | -- > info_hash=<url_encoded_info_hash> | ||
140 | -- | ||
141 | addHashToURI :: URI -> InfoHash -> URI | ||
142 | addHashToURI uri s = uri { | ||
143 | uriQuery = uriQuery uri ++ mkPref (uriQuery uri) ++ | ||
144 | "info_hash=" ++ rfc1738Encode (BC.unpack (getInfoHash s)) | ||
145 | } | ||
146 | where | ||
147 | mkPref [] = "?" | ||
148 | mkPref ('?' : _) = "&" | ||
149 | mkPref _ = error "addHashToURI" | ||
150 | |||
151 | rfc1738Encode = L.concatMap (\c -> if unreservedS c then [c] else encodeHex c) | ||
152 | where | ||
153 | unreservedS = (`L.elem` chars) | ||
154 | chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_./" | ||
155 | encodeHex c = '%' : pHex c | ||
156 | pHex c = let p = (showHex . ord $ c) "" | ||
157 | in if L.length p == 1 then '0' : p else p | ||
158 | |||
159 | {----------------------------------------------------------------------- | ||
160 | Torrent metainfo | ||
161 | -----------------------------------------------------------------------} | ||
87 | 162 | ||
88 | type Time = Text | 163 | type Time = Text |
89 | 164 | ||
165 | -- | Contain info about one single file. | ||
166 | data FileInfo = FileInfo { | ||
167 | fiLength :: !Integer | ||
168 | -- ^ Length of the file in bytes. | ||
169 | |||
170 | , fiMD5sum :: Maybe ByteString | ||
171 | -- ^ 32 character long MD5 sum of the file. | ||
172 | -- Used by third-party tools, not by bittorrent protocol itself. | ||
173 | |||
174 | , fiPath :: ![ByteString] | ||
175 | -- ^ One or more string elements that together represent the | ||
176 | -- path and filename. Each element in the list corresponds to | ||
177 | -- either a directory name or (in the case of the last | ||
178 | -- element) the filename. For example, the file: | ||
179 | -- | ||
180 | -- > "dir1/dir2/file.ext" | ||
181 | -- | ||
182 | -- would consist of three string elements: | ||
183 | -- | ||
184 | -- > ["dir1", "dir2", "file.ext"] | ||
185 | -- | ||
186 | } deriving (Show, Read, Eq) | ||
187 | |||
188 | $(deriveJSON (L.map toLower . L.dropWhile isLower) ''FileInfo) | ||
189 | |||
190 | |||
191 | -- | Info part of the .torrent file contain info about each content file. | ||
192 | data ContentInfo = | ||
193 | SingleFile { | ||
194 | ciLength :: !Integer | ||
195 | -- ^ Length of the file in bytes. | ||
196 | |||
197 | , ciMD5sum :: Maybe ByteString | ||
198 | -- ^ 32 character long MD5 sum of the file. | ||
199 | -- Used by third-party tools, not by bittorrent protocol itself. | ||
200 | |||
201 | , ciName :: !ByteString | ||
202 | -- ^ Suggested name of the file single file. | ||
203 | |||
204 | |||
205 | |||
206 | , ciPieceLength :: !Int | ||
207 | -- ^ Number of bytes in each piece. | ||
208 | |||
209 | , ciPieces :: !ByteString | ||
210 | -- ^ Concatenation of all 20-byte SHA1 hash values. | ||
211 | |||
212 | , ciPrivate :: Maybe Bool | ||
213 | -- ^ If set the client MUST publish its presence to get other | ||
214 | -- peers ONLY via the trackers explicity described in the | ||
215 | -- metainfo file. | ||
216 | -- | ||
217 | -- BEP 27: <http://www.bittorrent.org/beps/bep_0027.html> | ||
218 | } | ||
219 | |||
220 | | MultiFile { | ||
221 | ciFiles :: ![FileInfo] | ||
222 | -- ^ List of the all files that torrent contains. | ||
223 | |||
224 | , ciName :: !ByteString | ||
225 | -- | The file path of the directory in which to store all the files. | ||
226 | |||
227 | , ciPieceLength :: !Int | ||
228 | , ciPieces :: !ByteString | ||
229 | , ciPrivate :: Maybe Bool | ||
230 | } deriving (Show, Read, Eq) | ||
231 | |||
232 | $(deriveJSON id ''ContentInfo) | ||
233 | |||
90 | -- TODO more convenient form of torrent info. | 234 | -- TODO more convenient form of torrent info. |
91 | -- | Metainfo about particular torrent. | 235 | -- | Metainfo about particular torrent. |
92 | data Torrent = Torrent { | 236 | data Torrent = Torrent { |
@@ -153,72 +297,6 @@ simpleTorrent announce info = torrent announce info | |||
153 | 297 | ||
154 | -- TODO check if pieceLength is power of 2 | 298 | -- TODO check if pieceLength is power of 2 |
155 | 299 | ||
156 | -- | Info part of the .torrent file contain info about each content file. | ||
157 | data ContentInfo = | ||
158 | SingleFile { | ||
159 | ciLength :: !Integer | ||
160 | -- ^ Length of the file in bytes. | ||
161 | |||
162 | , ciMD5sum :: Maybe ByteString | ||
163 | -- ^ 32 character long MD5 sum of the file. | ||
164 | -- Used by third-party tools, not by bittorrent protocol itself. | ||
165 | |||
166 | , ciName :: !ByteString | ||
167 | -- ^ Suggested name of the file single file. | ||
168 | |||
169 | |||
170 | |||
171 | , ciPieceLength :: !Int | ||
172 | -- ^ Number of bytes in each piece. | ||
173 | |||
174 | , ciPieces :: !ByteString | ||
175 | -- ^ Concatenation of all 20-byte SHA1 hash values. | ||
176 | |||
177 | , ciPrivate :: Maybe Bool | ||
178 | -- ^ If set the client MUST publish its presence to get other | ||
179 | -- peers ONLY via the trackers explicity described in the | ||
180 | -- metainfo file. | ||
181 | -- | ||
182 | -- BEP 27: <http://www.bittorrent.org/beps/bep_0027.html> | ||
183 | } | ||
184 | |||
185 | | MultiFile { | ||
186 | ciFiles :: ![FileInfo] | ||
187 | -- ^ List of the all files that torrent contains. | ||
188 | |||
189 | , ciName :: !ByteString | ||
190 | -- | The file path of the directory in which to store all the files. | ||
191 | |||
192 | , ciPieceLength :: !Int | ||
193 | , ciPieces :: !ByteString | ||
194 | , ciPrivate :: Maybe Bool | ||
195 | } deriving (Show, Read, Eq) | ||
196 | |||
197 | |||
198 | -- | Contain info about one single file. | ||
199 | data FileInfo = FileInfo { | ||
200 | fiLength :: !Integer | ||
201 | -- ^ Length of the file in bytes. | ||
202 | |||
203 | , fiMD5sum :: Maybe ByteString | ||
204 | -- ^ 32 character long MD5 sum of the file. | ||
205 | -- Used by third-party tools, not by bittorrent protocol itself. | ||
206 | |||
207 | , fiPath :: ![ByteString] | ||
208 | -- ^ One or more string elements that together represent the | ||
209 | -- path and filename. Each element in the list corresponds to | ||
210 | -- either a directory name or (in the case of the last | ||
211 | -- element) the filename. For example, the file: | ||
212 | -- | ||
213 | -- > "dir1/dir2/file.ext" | ||
214 | -- | ||
215 | -- would consist of three string elements: | ||
216 | -- | ||
217 | -- > ["dir1", "dir2", "file.ext"] | ||
218 | -- | ||
219 | } deriving (Show, Read, Eq) | ||
220 | |||
221 | |||
222 | instance BEncodable URI where | 300 | instance BEncodable URI where |
223 | toBEncode uri = toBEncode (BC.pack (uriToString id uri "")) | 301 | toBEncode uri = toBEncode (BC.pack (uriToString id uri "")) |
224 | {-# INLINE toBEncode #-} | 302 | {-# INLINE toBEncode #-} |
@@ -390,71 +468,4 @@ fromFile filepath = do | |||
390 | contents <- B.readFile filepath | 468 | contents <- B.readFile filepath |
391 | case decoded contents of | 469 | case decoded contents of |
392 | Right !t -> return t | 470 | Right !t -> return t |
393 | Left msg -> throwIO $ userError $ msg ++ " while reading torrent" | 471 | Left msg -> throwIO $ userError $ msg ++ " while reading torrent" \ No newline at end of file |
394 | |||
395 | {----------------------------------------------------------------------- | ||
396 | Info hash | ||
397 | -----------------------------------------------------------------------} | ||
398 | |||
399 | -- | Exactly 20 bytes long SHA1 hash of the info part of torrent file. | ||
400 | newtype InfoHash = InfoHash { getInfoHash :: ByteString } | ||
401 | deriving (Eq, Ord) | ||
402 | |||
403 | instance Hashable InfoHash where | ||
404 | hash = Hashable.hash . getInfoHash | ||
405 | |||
406 | instance BEncodable InfoHash where | ||
407 | toBEncode = toBEncode . getInfoHash | ||
408 | fromBEncode be = InfoHash <$> fromBEncode be | ||
409 | |||
410 | instance Show InfoHash where | ||
411 | show = render . ppInfoHash | ||
412 | |||
413 | instance Serialize InfoHash where | ||
414 | put = putByteString . getInfoHash | ||
415 | get = InfoHash <$> getBytes 20 | ||
416 | |||
417 | instance BEncodable a => BEncodable (Map InfoHash a) where | ||
418 | {-# SPECIALIZE instance BEncodable a => BEncodable (Map InfoHash a) #-} | ||
419 | fromBEncode b = M.mapKeys InfoHash <$> fromBEncode b | ||
420 | {-# INLINE fromBEncode #-} | ||
421 | |||
422 | toBEncode = toBEncode . M.mapKeys getInfoHash | ||
423 | {-# INLINE toBEncode #-} | ||
424 | |||
425 | -- | Hash strict bytestring using SHA1 algorithm. | ||
426 | hash :: ByteString -> InfoHash | ||
427 | hash = InfoHash . C.hash | ||
428 | |||
429 | -- | Hash lazy bytestring using SHA1 algorithm. | ||
430 | hashlazy :: Lazy.ByteString -> InfoHash | ||
431 | hashlazy = InfoHash . C.hashlazy | ||
432 | |||
433 | -- | Pretty print info hash in hexadecimal format. | ||
434 | ppInfoHash :: InfoHash -> Doc | ||
435 | ppInfoHash = text . BC.unpack . ppHex . getInfoHash | ||
436 | |||
437 | ppHex :: ByteString -> ByteString | ||
438 | ppHex = Lazy.toStrict . B.toLazyByteString . B.byteStringHexFixed | ||
439 | |||
440 | -- | Add query info hash parameter to uri. | ||
441 | -- | ||
442 | -- > info_hash=<url_encoded_info_hash> | ||
443 | -- | ||
444 | addHashToURI :: URI -> InfoHash -> URI | ||
445 | addHashToURI uri s = uri { | ||
446 | uriQuery = uriQuery uri ++ mkPref (uriQuery uri) ++ | ||
447 | "info_hash=" ++ rfc1738Encode (BC.unpack (getInfoHash s)) | ||
448 | } | ||
449 | where | ||
450 | mkPref [] = "?" | ||
451 | mkPref ('?' : _) = "&" | ||
452 | mkPref _ = error "addHashToURI" | ||
453 | |||
454 | rfc1738Encode = L.concatMap (\c -> if unreservedS c then [c] else encodeHex c) | ||
455 | where | ||
456 | unreservedS = (`L.elem` chars) | ||
457 | chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789-_./" | ||
458 | encodeHex c = '%' : pHex c | ||
459 | pHex c = let p = (showHex . ord $ c) "" | ||
460 | in if L.length p == 1 then '0' : p else p | ||