summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/Tracker
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent/Tracker')
-rw-r--r--src/Network/BitTorrent/Tracker/Message.hs61
1 files changed, 33 insertions, 28 deletions
diff --git a/src/Network/BitTorrent/Tracker/Message.hs b/src/Network/BitTorrent/Tracker/Message.hs
index 3437dcf3..0df889d3 100644
--- a/src/Network/BitTorrent/Tracker/Message.hs
+++ b/src/Network/BitTorrent/Tracker/Message.hs
@@ -64,7 +64,6 @@ import Data.Serialize as S hiding (Result)
64import Data.Text (Text) 64import Data.Text (Text)
65import Data.Text.Encoding 65import Data.Text.Encoding
66import Data.Typeable 66import Data.Typeable
67import Data.URLEncoded as URL
68import Data.Word 67import Data.Word
69import Network 68import Network
70import Network.HTTP.Types.QueryLike 69import Network.HTTP.Types.QueryLike
@@ -95,11 +94,10 @@ data Event = Started
95$(deriveJSON (L.map toLower . L.dropWhile isLower) ''Event) 94$(deriveJSON (L.map toLower . L.dropWhile isLower) ''Event)
96 95
97-- | HTTP tracker protocol compatible encoding. 96-- | HTTP tracker protocol compatible encoding.
98instance URLShow Event where 97instance QueryValueLike Event where
99 urlShow e = urlShow (Char.toLower x : xs) 98 toQueryValue e = toQueryValue (Char.toLower x : xs)
100 where 99 where
101 -- INVARIANT: this is always nonempty list 100 (x : xs) = show e -- INVARIANT: this is always nonempty list
102 (x : xs) = show e
103 101
104type EventId = Word32 102type EventId = Word32
105 103
@@ -165,30 +163,31 @@ data AnnounceQuery = AnnounceQuery
165 163
166$(deriveJSON (L.map toLower . L.dropWhile isLower) ''AnnounceQuery) 164$(deriveJSON (L.map toLower . L.dropWhile isLower) ''AnnounceQuery)
167 165
168instance URLShow PortNumber where 166-- instance URLShow PortNumber where
169 urlShow = urlShow . fromEnum 167-- urlShow = urlShow . fromEnum
170 168
171instance URLShow Word32 where 169-- instance URLShow Word32 where
172 urlShow = show 170-- urlShow = show
173 {-# INLINE urlShow #-} 171-- {-# INLINE urlShow #-}
174 172
175-- | HTTP tracker protocol compatible encoding. 173
176instance URLEncode AnnounceQuery where 174--instance URLEncode AnnounceQuery where
177 urlEncode AnnounceQuery {..} = mconcat 175-- urlEncode AnnounceQuery {..} = mconcat
178 [ -- s "peer_id" %= reqPeerId 176-- [ -- s "peer_id" %= reqPeerId
179 s "port" %= reqPort 177-- s "port" %= reqPort
180-- , urlEncode reqProgress 178-- , urlEncode reqProgress
181 , s "ip" %=? reqIP 179-- , s "ip" %=? reqIP
182 , s "numwant" %=? reqNumWant 180-- , s "numwant" %=? reqNumWant
183 , s "event" %=? reqEvent 181-- , s "event" %=? reqEvent
184 ] 182-- ]
185 where s :: String -> String; s = id; {-# INLINE s #-} 183-- where s :: String -> String; s = id; {-# INLINE s #-}
186 184
185-- | HTTP tracker protocol compatible encoding.
187instance QueryLike AnnounceQuery where 186instance QueryLike AnnounceQuery where
188 toQuery AnnounceQuery {..} = 187 toQuery AnnounceQuery {..} =
189 [ ("info_hash", toQueryValue reqInfoHash) 188 [ ("info_hash", toQueryValue reqInfoHash)
190 , ("peer_id" , toQueryValue reqPeerId) 189 , ("peer_id" , toQueryValue reqPeerId)
191 ] 190 ]
192 191
193-- | UDP tracker protocol compatible encoding. 192-- | UDP tracker protocol compatible encoding.
194instance Serialize AnnounceQuery where 193instance Serialize AnnounceQuery where
@@ -227,12 +226,18 @@ instance Serialize AnnounceQuery where
227 , reqEvent = ev 226 , reqEvent = ev
228 } 227 }
229 228
229--renderAnnounceQueryBuilder :: AnnounceQuery -> BS.Builder
230--renderAnnounceQueryBuilder = undefined
231
230-- | Encode announce query and add it to the base tracker URL. 232-- | Encode announce query and add it to the base tracker URL.
231renderAnnounceQuery :: URI -> AnnounceQuery -> URI 233renderAnnounceQuery :: AnnounceQuery -> SimpleQuery
232renderAnnounceQuery announceURI req 234renderAnnounceQuery req = undefined
233 = URL.urlEncode req 235 where
234 `addToURI` announceURI 236 filterMaybes :: [(a, Maybe b)] -> [(a, b)]
235 `addHashToURI` reqInfoHash req 237 filterMaybes = catMaybes . L.map f
238 where
239 f (a, Nothing) = Nothing
240 f (a, Just b ) = Just (a, b)
236 241
237data QueryParam 242data QueryParam
238 = ParamInfoHash 243 = ParamInfoHash