summaryrefslogtreecommitdiff
path: root/src/Data/Torrent
diff options
context:
space:
mode:
Diffstat (limited to 'src/Data/Torrent')
-rw-r--r--src/Data/Torrent/Block.hs27
-rw-r--r--src/Data/Torrent/Client.hs20
-rw-r--r--src/Data/Torrent/InfoHash.hs13
-rw-r--r--src/Data/Torrent/Layout.hs17
-rw-r--r--src/Data/Torrent/Magnet.hs5
-rw-r--r--src/Data/Torrent/Piece.hs17
-rw-r--r--src/Data/Torrent/Progress.hs8
-rw-r--r--src/Data/Torrent/Tree.hs2
8 files changed, 53 insertions, 56 deletions
diff --git a/src/Data/Torrent/Block.hs b/src/Data/Torrent/Block.hs
index cb50302c..987de653 100644
--- a/src/Data/Torrent/Block.hs
+++ b/src/Data/Torrent/Block.hs
@@ -9,6 +9,7 @@
9-- 9--
10{-# LANGUAGE GeneralizedNewtypeDeriving #-} 10{-# LANGUAGE GeneralizedNewtypeDeriving #-}
11{-# LANGUAGE TemplateHaskell #-} 11{-# LANGUAGE TemplateHaskell #-}
12{-# LANGUAGE FlexibleInstances #-}
12module Data.Torrent.Block 13module Data.Torrent.Block
13 ( -- * Piece attributes 14 ( -- * Piece attributes
14 PieceIx 15 PieceIx
@@ -22,31 +23,26 @@ module Data.Torrent.Block
22 23
23 -- * Block index 24 -- * Block index
24 , BlockIx(..) 25 , BlockIx(..)
25 , ppBlockIx
26 , blockIxRange 26 , blockIxRange
27 27
28 -- * Block data 28 -- * Block data
29 , Block(..) 29 , Block(..)
30 , ppBlock
31 , blockIx 30 , blockIx
32 , blockSize 31 , blockSize
33 , blockRange 32 , blockRange
34 ) where 33 ) where
35 34
36import Control.Applicative 35import Control.Applicative
37
38import Data.Aeson.TH 36import Data.Aeson.TH
39import qualified Data.ByteString.Lazy as Lazy 37import qualified Data.ByteString.Lazy as Lazy
40import Data.Char 38import Data.Char
41import Data.List as L 39import Data.List as L
42
43import Data.Binary as B 40import Data.Binary as B
44import Data.Binary.Get as B 41import Data.Binary.Get as B
45import Data.Binary.Put as B 42import Data.Binary.Put as B
46import Data.Serialize as S 43import Data.Serialize as S
47
48import Text.PrettyPrint 44import Text.PrettyPrint
49 45import Text.PrettyPrint.Class
50 46
51{----------------------------------------------------------------------- 47{-----------------------------------------------------------------------
52-- Piece attributes 48-- Piece attributes
@@ -147,12 +143,11 @@ instance Binary BlockIx where
147 putIntB ixOffset 143 putIntB ixOffset
148 putIntB ixLength 144 putIntB ixLength
149 145
150-- | Format block index in human readable form. 146instance Pretty BlockIx where
151ppBlockIx :: BlockIx -> Doc 147 pretty BlockIx {..} =
152ppBlockIx BlockIx {..} = 148 "piece = " <> int ixPiece <> "," <+>
153 "piece = " <> int ixPiece <> "," <+> 149 "offset = " <> int ixOffset <> "," <+>
154 "offset = " <> int ixOffset <> "," <+> 150 "length = " <> int ixLength
155 "length = " <> int ixLength
156 151
157-- | Get location of payload bytes in the torrent content. 152-- | Get location of payload bytes in the torrent content.
158blockIxRange :: (Num a, Integral a) => PieceSize -> BlockIx -> (a, a) 153blockIxRange :: (Num a, Integral a) => PieceSize -> BlockIx -> (a, a)
@@ -178,10 +173,10 @@ data Block payload = Block {
178 , blkData :: !payload 173 , blkData :: !payload
179 } deriving (Show, Eq) 174 } deriving (Show, Eq)
180 175
181-- | Format block in human readable form. Payload is ommitted. 176-- | Payload is ommitted.
182ppBlock :: Block Lazy.ByteString -> Doc 177instance Pretty (Block Lazy.ByteString) where
183ppBlock = ppBlockIx . blockIx 178 pretty = pretty . blockIx
184{-# INLINE ppBlock #-} 179 {-# INLINE pretty #-}
185 180
186-- | Get size of block /payload/ in bytes. 181-- | Get size of block /payload/ in bytes.
187blockSize :: Block Lazy.ByteString -> BlockSize 182blockSize :: Block Lazy.ByteString -> BlockSize
diff --git a/src/Data/Torrent/Client.hs b/src/Data/Torrent/Client.hs
index f38f7a5c..0fd6722b 100644
--- a/src/Data/Torrent/Client.hs
+++ b/src/Data/Torrent/Client.hs
@@ -22,10 +22,7 @@
22-- 22--
23module Data.Torrent.Client 23module Data.Torrent.Client
24 ( ClientImpl (..) 24 ( ClientImpl (..)
25 , ppClientImpl
26 , ppVersion
27 , ClientInfo (..) 25 , ClientInfo (..)
28 , ppClientInfo
29 , libClientInfo 26 , libClientInfo
30 ) where 27 ) where
31 28
@@ -41,6 +38,7 @@ import Data.String
41import Data.Text as T 38import Data.Text as T
42import Data.Version 39import Data.Version
43import Text.PrettyPrint hiding ((<>)) 40import Text.PrettyPrint hiding ((<>))
41import Text.PrettyPrint.Class
44import Text.Read (readMaybe) 42import Text.Read (readMaybe)
45import Paths_bittorrent (version) 43import Paths_bittorrent (version)
46 44
@@ -125,9 +123,8 @@ instance IsString ClientImpl where
125 alist = L.map mk [minBound..maxBound] 123 alist = L.map mk [minBound..maxBound]
126 mk x = (L.tail $ show x, x) 124 mk x = (L.tail $ show x, x)
127 125
128-- | Format client implementation info in human-readable form. 126instance Pretty ClientImpl where
129ppClientImpl :: ClientImpl -> Doc 127 pretty = text . L.tail . show
130ppClientImpl = text . L.tail . show
131 128
132-- | Just the '0' version. 129-- | Just the '0' version.
133instance Default Version where 130instance Default Version where
@@ -141,9 +138,8 @@ instance IsString Version where
141 where 138 where
142 chunkNums = sequence . L.map readMaybe . L.linesBy ('.' ==) 139 chunkNums = sequence . L.map readMaybe . L.linesBy ('.' ==)
143 140
144-- | Format client implementation version in human-readable form. 141instance Pretty Version where
145ppVersion :: Version -> Doc 142 pretty = text . showVersion
146ppVersion = text . showVersion
147 143
148-- | The all sensible infomation that can be obtained from a peer 144-- | The all sensible infomation that can be obtained from a peer
149-- identifier or torrent /createdBy/ field. 145-- identifier or torrent /createdBy/ field.
@@ -164,10 +160,8 @@ instance IsString ClientInfo where
164 where 160 where
165 (impl, _ver) = L.span ((/=) '-') str 161 (impl, _ver) = L.span ((/=) '-') str
166 162
167-- | Format client info in human-readable form. 163instance Pretty ClientInfo where
168ppClientInfo :: ClientInfo -> Doc 164 pretty ClientInfo {..} = pretty ciImpl <+> "version" <+> pretty ciVersion
169ppClientInfo ClientInfo {..} =
170 ppClientImpl ciImpl <+> "version" <+> ppVersion ciVersion
171 165
172-- | Client info of this (the bittorrent library) package. Normally, 166-- | Client info of this (the bittorrent library) package. Normally,
173-- applications should introduce its own idenitifiers, otherwise they 167-- applications should introduce its own idenitifiers, otherwise they
diff --git a/src/Data/Torrent/InfoHash.hs b/src/Data/Torrent/InfoHash.hs
index 2e3946eb..e15fdbb3 100644
--- a/src/Data/Torrent/InfoHash.hs
+++ b/src/Data/Torrent/InfoHash.hs
@@ -19,11 +19,9 @@ module Data.Torrent.InfoHash
19 -- * Rendering 19 -- * Rendering
20 , longHex 20 , longHex
21 , shortHex 21 , shortHex
22 , ppInfoHash
23 22
24 , addHashToURI 23 , addHashToURI
25 24
26
27 , Data.Torrent.InfoHash.hash 25 , Data.Torrent.InfoHash.hash
28 , Data.Torrent.InfoHash.hashlazy 26 , Data.Torrent.InfoHash.hashlazy
29 ) where 27 ) where
@@ -52,6 +50,7 @@ import Network.URI
52import Numeric 50import Numeric
53import Text.ParserCombinators.ReadP as P 51import Text.ParserCombinators.ReadP as P
54import Text.PrettyPrint 52import Text.PrettyPrint
53import Text.PrettyPrint.Class
55 54
56 55
57-- | Exactly 20 bytes long SHA1 hash of the info part of torrent file. 56-- | Exactly 20 bytes long SHA1 hash of the info part of torrent file.
@@ -60,7 +59,7 @@ newtype InfoHash = InfoHash { getInfoHash :: BS.ByteString }
60 59
61-- | for hex encoded strings 60-- | for hex encoded strings
62instance Show InfoHash where 61instance Show InfoHash where
63 show = render . ppInfoHash 62 show = render . pretty
64 63
65-- | for hex encoded strings 64-- | for hex encoded strings
66instance Read InfoHash where 65instance Read InfoHash where
@@ -106,6 +105,10 @@ instance FromJSON InfoHash where
106instance URLShow InfoHash where 105instance URLShow InfoHash where
107 urlShow = show 106 urlShow = show
108 107
108-- | base16 encoded.
109instance Pretty InfoHash where
110 pretty = text . BC.unpack . ppHex . getInfoHash
111
109-- | Tries both base16 and base32 while decoding info hash. 112-- | Tries both base16 and base32 while decoding info hash.
110textToInfoHash :: Text -> Maybe InfoHash 113textToInfoHash :: Text -> Maybe InfoHash
111textToInfoHash text 114textToInfoHash text
@@ -127,10 +130,6 @@ longHex = T.decodeUtf8 . Base16.encode . getInfoHash
127shortHex :: InfoHash -> Text 130shortHex :: InfoHash -> Text
128shortHex = T.take 7 . longHex 131shortHex = T.take 7 . longHex
129 132
130-- | Pretty print info hash in hexadecimal format.
131ppInfoHash :: InfoHash -> Doc
132ppInfoHash = text . BC.unpack . ppHex . getInfoHash
133
134ppHex :: BS.ByteString -> BS.ByteString 133ppHex :: BS.ByteString -> BS.ByteString
135ppHex = BL.toStrict . B.toLazyByteString . B.byteStringHexFixed 134ppHex = BL.toStrict . B.toLazyByteString . B.byteStringHexFixed
136 135
diff --git a/src/Data/Torrent/Layout.hs b/src/Data/Torrent/Layout.hs
index 84085a92..70908c4e 100644
--- a/src/Data/Torrent/Layout.hs
+++ b/src/Data/Torrent/Layout.hs
@@ -24,7 +24,6 @@ module Data.Torrent.Layout
24 24
25 -- * Single file info 25 -- * Single file info
26 , FileInfo (..) 26 , FileInfo (..)
27 , ppFileInfo
28 27
29 -- ** Lens 28 -- ** Lens
30 , fileLength 29 , fileLength
@@ -33,7 +32,6 @@ module Data.Torrent.Layout
33 32
34 -- * File layout 33 -- * File layout
35 , LayoutInfo (..) 34 , LayoutInfo (..)
36 , ppLayoutInfo
37 , joinFilePath 35 , joinFilePath
38 36
39 -- ** Lens 37 -- ** Lens
@@ -78,6 +76,7 @@ import Data.Text as T
78import Data.Text.Encoding as T 76import Data.Text.Encoding as T
79import Data.Typeable 77import Data.Typeable
80import Text.PrettyPrint as PP 78import Text.PrettyPrint as PP
79import Text.PrettyPrint.Class
81import System.FilePath 80import System.FilePath
82import System.Posix.Types 81import System.Posix.Types
83 82
@@ -175,13 +174,12 @@ instance BEncode (FileInfo ByteString) where
175 fromBEncode = fromDict getFileInfoSingle 174 fromBEncode = fromDict getFileInfoSingle
176 {-# INLINE fromBEncode #-} 175 {-# INLINE fromBEncode #-}
177 176
178-- | Format 'FileInfo' in human-readable form. 177instance Pretty (FileInfo BS.ByteString) where
179ppFileInfo :: FileInfo ByteString -> Doc 178 pretty FileInfo {..} =
180ppFileInfo FileInfo {..} =
181 "Path: " <> text (T.unpack (T.decodeUtf8 fiName)) 179 "Path: " <> text (T.unpack (T.decodeUtf8 fiName))
182 $$ "Size: " <> text (show fiLength) 180 $$ "Size: " <> text (show fiLength)
183 $$ maybe PP.empty ppMD5 fiMD5Sum 181 $$ maybe PP.empty ppMD5 fiMD5Sum
184 where 182 where
185 ppMD5 md5 = "MD5 : " <> text (show (InfoHash md5)) 183 ppMD5 md5 = "MD5 : " <> text (show (InfoHash md5))
186 184
187-- | Join file path. 185-- | Join file path.
@@ -242,10 +240,9 @@ instance BEncode LayoutInfo where
242 toBEncode = toDict . (`putLayoutInfo` endDict) 240 toBEncode = toDict . (`putLayoutInfo` endDict)
243 fromBEncode = fromDict getLayoutInfo 241 fromBEncode = fromDict getLayoutInfo
244 242
245-- | Format 'LayoutInfo' in human readable form. 243instance Pretty LayoutInfo where
246ppLayoutInfo :: LayoutInfo -> Doc 244 pretty SingleFile {..} = pretty liFile
247ppLayoutInfo SingleFile {..} = ppFileInfo liFile 245 pretty MultiFile {..} = vcat $ L.map (pretty . joinFilePath) liFiles
248ppLayoutInfo MultiFile {..} = vcat $ L.map (ppFileInfo . joinFilePath) liFiles
249 246
250-- | Test if this is single file torrent. 247-- | Test if this is single file torrent.
251isSingleFile :: LayoutInfo -> Bool 248isSingleFile :: LayoutInfo -> Bool
diff --git a/src/Data/Torrent/Magnet.hs b/src/Data/Torrent/Magnet.hs
index 01f28a76..791537b1 100644
--- a/src/Data/Torrent/Magnet.hs
+++ b/src/Data/Torrent/Magnet.hs
@@ -43,6 +43,8 @@ import Data.Text as T
43import Data.Text.Encoding as T 43import Data.Text.Encoding as T
44import Network.URI 44import Network.URI
45import Text.Read 45import Text.Read
46import Text.PrettyPrint as PP
47import Text.PrettyPrint.Class
46 48
47import Data.Torrent 49import Data.Torrent
48import Data.Torrent.InfoHash 50import Data.Torrent.InfoHash
@@ -148,6 +150,9 @@ instance URLEncode Magnet where
148 urlEncode = toQuery 150 urlEncode = toQuery
149 {-# INLINE urlEncode #-} 151 {-# INLINE urlEncode #-}
150 152
153instance Pretty Magnet where
154 pretty = PP.text . renderMagnet
155
151-- | Set exact topic only, other params are empty. 156-- | Set exact topic only, other params are empty.
152nullMagnet :: InfoHash -> Magnet 157nullMagnet :: InfoHash -> Magnet
153nullMagnet u = Magnet 158nullMagnet u = Magnet
diff --git a/src/Data/Torrent/Piece.hs b/src/Data/Torrent/Piece.hs
index c8727a65..6cff53d6 100644
--- a/src/Data/Torrent/Piece.hs
+++ b/src/Data/Torrent/Piece.hs
@@ -21,13 +21,11 @@ module Data.Torrent.Piece
21 21
22 -- * Piece data 22 -- * Piece data
23 , Piece (..) 23 , Piece (..)
24 , ppPiece
25 , pieceSize 24 , pieceSize
26 , isPiece 25 , isPiece
27 26
28 -- * Piece control 27 -- * Piece control
29 , PieceInfo (..) 28 , PieceInfo (..)
30 , ppPieceInfo
31 , pieceCount 29 , pieceCount
32 30
33 -- * Lens 31 -- * Lens
@@ -61,6 +59,7 @@ import Data.List as L
61import Data.Text.Encoding as T 59import Data.Text.Encoding as T
62import Data.Typeable 60import Data.Typeable
63import Text.PrettyPrint 61import Text.PrettyPrint
62import Text.PrettyPrint.Class
64 63
65import Data.Torrent.Block 64import Data.Torrent.Block
66 65
@@ -121,10 +120,9 @@ $(deriveJSON (L.map toLower . L.dropWhile isLower) ''Piece)
121 120
122instance NFData (Piece a) 121instance NFData (Piece a)
123 122
124-- | Format piece in human readable form. Payload bytes are omitted. 123-- | Payload bytes are omitted.
125ppPiece :: Piece a -> Doc 124instance Pretty (Piece a) where
126ppPiece Piece {..} 125 pretty Piece {..} = "Piece" <+> braces ("index" <+> "=" <+> int pieceIndex)
127 = "Piece" <+> braces ("index" <+> "=" <+> int pieceIndex)
128 126
129-- | Get size of piece in bytes. 127-- | Get size of piece in bytes.
130pieceSize :: Piece BL.ByteString -> PieceSize 128pieceSize :: Piece BL.ByteString -> PieceSize
@@ -192,10 +190,9 @@ instance BEncode PieceInfo where
192 toBEncode = toDict . (`putPieceInfo` endDict) 190 toBEncode = toDict . (`putPieceInfo` endDict)
193 fromBEncode = fromDict getPieceInfo 191 fromBEncode = fromDict getPieceInfo
194 192
195-- | Format piece info in human readable form. Hashes are omitted. 193-- | Hashes are omitted.
196ppPieceInfo :: PieceInfo -> Doc 194instance Pretty PieceInfo where
197ppPieceInfo PieceInfo {..} = 195 pretty PieceInfo {..} = "Piece size: " <> int piPieceLength
198 "Piece size: " <> int piPieceLength
199 196
200hashsize :: Int 197hashsize :: Int
201hashsize = 20 198hashsize = 20
diff --git a/src/Data/Torrent/Progress.hs b/src/Data/Torrent/Progress.hs
index 18a9cd7d..d0aa75c6 100644
--- a/src/Data/Torrent/Progress.hs
+++ b/src/Data/Torrent/Progress.hs
@@ -43,6 +43,8 @@ import Data.Serialize as S
43import Data.Ratio 43import Data.Ratio
44import Data.URLEncoded 44import Data.URLEncoded
45import Data.Word 45import Data.Word
46import Text.PrettyPrint as PP
47import Text.PrettyPrint.Class
46 48
47 49
48-- | Progress data is considered as dynamic within one client 50-- | Progress data is considered as dynamic within one client
@@ -100,6 +102,12 @@ instance URLEncode Progress where
100 ] 102 ]
101 where s :: String -> String; s = id; {-# INLINE s #-} 103 where s :: String -> String; s = id; {-# INLINE s #-}
102 104
105instance Pretty Progress where
106 pretty Progress {..} =
107 "/\\" <+> PP.text (show _uploaded) $$
108 "\\/" <+> PP.text (show _downloaded) $$
109 "left" <+> PP.text (show _left)
110
103-- | Initial progress is used when there are no session before. 111-- | Initial progress is used when there are no session before.
104-- 112--
105-- Please note that tracker might penalize client some way if the do 113-- Please note that tracker might penalize client some way if the do
diff --git a/src/Data/Torrent/Tree.hs b/src/Data/Torrent/Tree.hs
index cf71c2ec..102f4dff 100644
--- a/src/Data/Torrent/Tree.hs
+++ b/src/Data/Torrent/Tree.hs
@@ -55,6 +55,8 @@ build MultiFile {..} = Dir $ M.singleton liDirName files
55--decompress :: DirTree () -> [FileInfo ()] 55--decompress :: DirTree () -> [FileInfo ()]
56--decompress = undefined 56--decompress = undefined
57 57
58-- TODO pretty print
59
58-- | Lookup file by path. 60-- | Lookup file by path.
59lookup :: [FilePath] -> DirTree a -> Maybe (DirTree a) 61lookup :: [FilePath] -> DirTree a -> Maybe (DirTree a)
60lookup [] t = Just t 62lookup [] t = Just t