summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Data/Torrent.hs151
1 files changed, 151 insertions, 0 deletions
diff --git a/src/Data/Torrent.hs b/src/Data/Torrent.hs
new file mode 100644
index 00000000..53ec4ff8
--- /dev/null
+++ b/src/Data/Torrent.hs
@@ -0,0 +1,151 @@
1{-# OPTIONS -fno-warn-orphans #-}
2{-# LANGUAGE OverloadedStrings #-}
3-- | This module provides torrent metainfo serialization.
4module Data.Torrent
5 ( Torrent(..), TorrentInfo(..), TorrentFile(..)
6 , fromFile
7 ) where
8
9import Control.Applicative
10import Control.Monad
11import qualified Data.Map as M
12import Data.ByteString (ByteString)
13import qualified Data.ByteString as B
14import qualified Data.ByteString.Char8 as BC (pack, unpack)
15import Data.Text (Text)
16import Crypto.Hash.SHA1
17import Data.BEncode
18import Network.URL
19
20type Time = Text
21
22-- TODO comment fields
23-- TODO more convenient form of torrent info.
24data Torrent = Torrent {
25 tInfoHash :: ByteString
26 , tAnnounce :: URL
27 , tAnnounceList :: Maybe [[URL]]
28 , tComment :: Maybe Text
29 , tCreatedBy :: Maybe ByteString
30 , tCreationDate :: Maybe Time
31 , tEncoding :: Maybe ByteString
32 , tInfo :: TorrentInfo
33 , tPublisher :: Maybe URL
34 , tPublisherURL :: Maybe URL
35 } deriving Show
36
37data TorrentInfo =
38 SingleFile {
39 tLength :: Int
40 , tMD5sum :: Maybe ByteString
41 , tName :: ByteString
42
43 , tPieceLength :: Int
44 , tPieces :: ByteString -- Vector ByteString?
45 , tPrivate :: Maybe Bool
46 }
47 | MultiFile {
48 tFiles :: [TorrentFile]
49 , tName :: ByteString
50
51 , tPieceLength :: Int
52 , tPieces :: ByteString -- Vector ByteString?
53 , tPrivate :: Maybe Bool
54 } deriving (Show, Read, Eq)
55
56data TorrentFile = TorrentFile {
57 tfLength :: Int
58 , tfMD5sum :: Maybe ByteString
59 , tfPath :: [ByteString]
60 } deriving (Show, Read, Eq)
61
62instance BEncodable URL where
63 toBEncode = toBEncode . BC.pack . exportURL -- TODO utf8 encoding
64 {-# INLINE toBEncode #-}
65
66 fromBEncode (BString s) | Just url <- importURL (BC.unpack s) = return url
67 fromBEncode b = decodingError $ "url <" ++ show b ++ ">"
68 {-# INLINE fromBEncode #-}
69
70instance BEncodable Torrent where
71 toBEncode t = fromAscAssocs
72 [ "announce" --> tAnnounce t
73 , "announce-list" -->? tAnnounceList t
74 , "comment" -->? tComment t
75 , "created by" -->? tCreatedBy t
76 , "creation date" -->? tCreationDate t
77 , "encoding" -->? tEncoding t
78 , "info" --> tInfo t
79 , "publisher" -->? tPublisher t
80 , "publisher-url" -->? tPublisherURL t
81 ]
82
83 fromBEncode (BDict d) | Just info <- M.lookup "info" d =
84 Torrent <$> pure (hashlazy (encode info))
85 <*> d >-- "announce"
86 <*> d >--? "announce-list"
87 <*> d >--? "comment"
88 <*> d >--? "created by"
89 <*> d >--? "creation date"
90 <*> d >--? "encoding"
91 <*> d >-- "info"
92 <*> d >--? "publisher"
93 <*> d >--? "publisher-url"
94
95 fromBEncode _ = decodingError "Torrent"
96
97
98instance BEncodable TorrentInfo where
99 toBEncode ti@(SingleFile { }) = fromAscAssocs
100 [ "length" --> tLength ti
101 , "md5sum" -->? tMD5sum ti
102 , "name" --> tName ti
103
104 , "piece length" --> tPieceLength ti
105 , "pieces" --> tPieces ti
106 , "private" -->? tPrivate ti
107 ]
108
109 toBEncode ti@(MultiFile {}) = fromAscAssocs
110 [ "files" --> tFiles ti
111 , "name" --> tName ti
112
113 , "piece length" --> tPieceLength ti
114 , "pieces" --> tPieces ti
115 , "private" -->? tPrivate ti
116 ]
117
118 fromBEncode (BDict d)
119 | Just (BList fs) <- M.lookup "files" d =
120 MultiFile <$> mapM fromBEncode fs
121 <*> d >-- "name"
122 <*> d >-- "piece length"
123 <*> d >-- "pieces"
124 <*> d >--? "private"
125 | otherwise =
126 SingleFile <$> d >-- "length"
127 <*> d >--? "md5sum"
128 <*> d >-- "name"
129 <*> d >-- "piece length"
130 <*> d >-- "pieces"
131 <*> d >--? "private"
132 fromBEncode _ = decodingError "TorrentInfo"
133
134
135instance BEncodable TorrentFile where
136 toBEncode tf = fromAssocs
137 [ "length" --> tfLength tf
138 , "md5sum" -->? tfMD5sum tf
139 , "path" --> tfPath tf
140 ]
141
142 fromBEncode (BDict d) =
143 TorrentFile <$> d >-- "length"
144 <*> d >--? "md5sum"
145 <*> d >-- "path"
146
147 fromBEncode _ = decodingError "TorrentFile"
148
149
150fromFile :: FilePath -> IO (Result Torrent)
151fromFile path = (fromBEncode <=< decode) <$> B.readFile path