summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Data/Torrent.hs4
-rw-r--r--src/Data/Torrent/Progress.hs24
-rw-r--r--src/Network/BitTorrent/Core/PeerId.hs11
-rw-r--r--src/Network/BitTorrent/Tracker/Message.hs13
4 files changed, 35 insertions, 17 deletions
diff --git a/src/Data/Torrent.hs b/src/Data/Torrent.hs
index e4b17c2b..d6227b6f 100644
--- a/src/Data/Torrent.hs
+++ b/src/Data/Torrent.hs
@@ -78,6 +78,7 @@ import Data.ByteString as BS
78import qualified Data.ByteString.Char8 as BC (pack, unpack) 78import qualified Data.ByteString.Char8 as BC (pack, unpack)
79import qualified Data.ByteString.Lazy as BL 79import qualified Data.ByteString.Lazy as BL
80import Data.Char as Char 80import Data.Char as Char
81import Data.Default
81import Data.Hashable as Hashable 82import Data.Hashable as Hashable
82import qualified Data.List as L 83import qualified Data.List as L
83import Data.Maybe 84import Data.Maybe
@@ -143,8 +144,7 @@ instance Hashable InfoDict where
143infoDictionary :: LayoutInfo -> PieceInfo -> Bool -> InfoDict 144infoDictionary :: LayoutInfo -> PieceInfo -> Bool -> InfoDict
144infoDictionary li pinfo private = InfoDict ih li pinfo private 145infoDictionary li pinfo private = InfoDict ih li pinfo private
145 where 146 where
146 ih = hashLazyIH $ encode $ InfoDict fake_ih li pinfo private 147 ih = hashLazyIH $ encode $ InfoDict def li pinfo private
147 fake_ih = "0123456789012345678901234567890123456789"
148 148
149getPrivate :: Get Bool 149getPrivate :: Get Bool
150getPrivate = (Just True ==) <$>? "private" 150getPrivate = (Just True ==) <$>? "private"
diff --git a/src/Data/Torrent/Progress.hs b/src/Data/Torrent/Progress.hs
index d0aa75c6..1a4a68e2 100644
--- a/src/Data/Torrent/Progress.hs
+++ b/src/Data/Torrent/Progress.hs
@@ -12,6 +12,7 @@
12-- 12--
13{-# LANGUAGE TemplateHaskell #-} 13{-# LANGUAGE TemplateHaskell #-}
14{-# LANGUAGE ViewPatterns #-} 14{-# LANGUAGE ViewPatterns #-}
15{-# OPTIONS -fno-warn-orphans #-}
15module Data.Torrent.Progress 16module Data.Torrent.Progress
16 ( -- * Progress 17 ( -- * Progress
17 Progress (..) 18 Progress (..)
@@ -36,13 +37,15 @@ module Data.Torrent.Progress
36import Control.Applicative 37import Control.Applicative
37import Control.Lens hiding ((%=)) 38import Control.Lens hiding ((%=))
38import Data.Aeson.TH 39import Data.Aeson.TH
40import Data.ByteString.Lazy.Builder as BS
41import Data.ByteString.Lazy.Builder.ASCII as BS
39import Data.Default 42import Data.Default
40import Data.List as L 43import Data.List as L
41import Data.Monoid 44import Data.Monoid
42import Data.Serialize as S 45import Data.Serialize as S
43import Data.Ratio 46import Data.Ratio
44import Data.URLEncoded
45import Data.Word 47import Data.Word
48import Network.HTTP.Types.QueryLike
46import Text.PrettyPrint as PP 49import Text.PrettyPrint as PP
47import Text.PrettyPrint.Class 50import Text.PrettyPrint.Class
48 51
@@ -89,18 +92,19 @@ instance Monoid Progress where
89 } 92 }
90 {-# INLINE mappend #-} 93 {-# INLINE mappend #-}
91 94
92instance URLShow Word64 where 95instance QueryValueLike Builder where
93 urlShow = show 96 toQueryValue = toQueryValue . BS.toLazyByteString
94 {-# INLINE urlShow #-} 97
98instance QueryValueLike Word64 where
99 toQueryValue = toQueryValue . BS.word64Dec
95 100
96-- | HTTP Tracker protocol compatible encoding. 101-- | HTTP Tracker protocol compatible encoding.
97instance URLEncode Progress where 102instance QueryLike Progress where
98 urlEncode Progress {..} = mconcat 103 toQuery Progress {..} =
99 [ s "uploaded" %= _uploaded 104 [ ("uploaded" , toQueryValue _uploaded)
100 , s "left" %= _left 105 , ("left" , toQueryValue _left)
101 , s "downloaded" %= _downloaded 106 , ("downloaded", toQueryValue _downloaded)
102 ] 107 ]
103 where s :: String -> String; s = id; {-# INLINE s #-}
104 108
105instance Pretty Progress where 109instance Pretty Progress where
106 pretty Progress {..} = 110 pretty Progress {..} =
diff --git a/src/Network/BitTorrent/Core/PeerId.hs b/src/Network/BitTorrent/Core/PeerId.hs
index a2b03e92..f5a40f29 100644
--- a/src/Network/BitTorrent/Core/PeerId.hs
+++ b/src/Network/BitTorrent/Core/PeerId.hs
@@ -46,12 +46,14 @@ import Data.List as L
46import Data.List.Split as L 46import Data.List.Split as L
47import Data.Maybe (fromMaybe, catMaybes) 47import Data.Maybe (fromMaybe, catMaybes)
48import Data.Monoid 48import Data.Monoid
49import Data.Hashable
49import Data.Serialize as S 50import Data.Serialize as S
50import Data.String 51import Data.String
51import Data.Time.Clock (getCurrentTime) 52import Data.Time.Clock (getCurrentTime)
52import Data.Time.Format (formatTime) 53import Data.Time.Format (formatTime)
53import Data.URLEncoded 54import Data.URLEncoded
54import Data.Version (Version(Version), versionBranch) 55import Data.Version (Version(Version), versionBranch)
56import Network.HTTP.Types.QueryLike
55import System.Entropy (getEntropy) 57import System.Entropy (getEntropy)
56import System.Locale (defaultTimeLocale) 58import System.Locale (defaultTimeLocale)
57import Text.PrettyPrint hiding ((<>)) 59import Text.PrettyPrint hiding ((<>))
@@ -70,12 +72,17 @@ newtype PeerId = PeerId { getPeerId :: ByteString }
70peerIdLen :: Int 72peerIdLen :: Int
71peerIdLen = 20 73peerIdLen = 20
72 74
75instance Hashable PeerId where
76 hash = hash . getPeerId
77 {-# INLINE hash #-}
78
73instance Serialize PeerId where 79instance Serialize PeerId where
74 put = putByteString . getPeerId 80 put = putByteString . getPeerId
75 get = PeerId <$> getBytes peerIdLen 81 get = PeerId <$> getBytes peerIdLen
76 82
77instance URLShow PeerId where 83instance QueryValueLike PeerId where
78 urlShow = BC.unpack . getPeerId 84 toQueryValue (PeerId pid) = Just pid
85 {-# INLINE toQueryValue #-}
79 86
80instance IsString PeerId where 87instance IsString PeerId where
81 fromString str 88 fromString str
diff --git a/src/Network/BitTorrent/Tracker/Message.hs b/src/Network/BitTorrent/Tracker/Message.hs
index 59ef2027..e5d8b25a 100644
--- a/src/Network/BitTorrent/Tracker/Message.hs
+++ b/src/Network/BitTorrent/Tracker/Message.hs
@@ -66,6 +66,7 @@ import Data.Typeable
66import Data.URLEncoded as URL 66import Data.URLEncoded as URL
67import Data.Word 67import Data.Word
68import Network 68import Network
69import Network.HTTP.Types.QueryLike
69import Network.HTTP.Types.URI hiding (urlEncode) 70import Network.HTTP.Types.URI hiding (urlEncode)
70import Network.Socket 71import Network.Socket
71import Network.URI 72import Network.URI
@@ -173,15 +174,21 @@ instance URLShow Word32 where
173-- | HTTP tracker protocol compatible encoding. 174-- | HTTP tracker protocol compatible encoding.
174instance URLEncode AnnounceQuery where 175instance URLEncode AnnounceQuery where
175 urlEncode AnnounceQuery {..} = mconcat 176 urlEncode AnnounceQuery {..} = mconcat
176 [ s "peer_id" %= reqPeerId 177 [ -- s "peer_id" %= reqPeerId
177 , s "port" %= reqPort 178 s "port" %= reqPort
178 , urlEncode reqProgress 179-- , urlEncode reqProgress
179 , s "ip" %=? reqIP 180 , s "ip" %=? reqIP
180 , s "numwant" %=? reqNumWant 181 , s "numwant" %=? reqNumWant
181 , s "event" %=? reqEvent 182 , s "event" %=? reqEvent
182 ] 183 ]
183 where s :: String -> String; s = id; {-# INLINE s #-} 184 where s :: String -> String; s = id; {-# INLINE s #-}
184 185
186instance QueryLike AnnounceQuery where
187 toQuery AnnounceQuery {..} =
188 [ ("info_hash", toQueryValue reqInfoHash)
189 , ("peer_id" , toQueryValue reqPeerId)
190 ]
191
185-- | UDP tracker protocol compatible encoding. 192-- | UDP tracker protocol compatible encoding.
186instance Serialize AnnounceQuery where 193instance Serialize AnnounceQuery where
187 put AnnounceQuery {..} = do 194 put AnnounceQuery {..} = do