diff options
Diffstat (limited to 'src/Network/BitTorrent/Tracker')
-rw-r--r-- | src/Network/BitTorrent/Tracker/Message.hs | 61 |
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) | |||
64 | import Data.Text (Text) | 64 | import Data.Text (Text) |
65 | import Data.Text.Encoding | 65 | import Data.Text.Encoding |
66 | import Data.Typeable | 66 | import Data.Typeable |
67 | import Data.URLEncoded as URL | ||
68 | import Data.Word | 67 | import Data.Word |
69 | import Network | 68 | import Network |
70 | import Network.HTTP.Types.QueryLike | 69 | import 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. |
98 | instance URLShow Event where | 97 | instance 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 | ||
104 | type EventId = Word32 | 102 | type 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 | ||
168 | instance URLShow PortNumber where | 166 | -- instance URLShow PortNumber where |
169 | urlShow = urlShow . fromEnum | 167 | -- urlShow = urlShow . fromEnum |
170 | 168 | ||
171 | instance 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 | |
176 | instance 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. | ||
187 | instance QueryLike AnnounceQuery where | 186 | instance 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. |
194 | instance Serialize AnnounceQuery where | 193 | instance 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. |
231 | renderAnnounceQuery :: URI -> AnnounceQuery -> URI | 233 | renderAnnounceQuery :: AnnounceQuery -> SimpleQuery |
232 | renderAnnounceQuery announceURI req | 234 | renderAnnounceQuery 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 | ||
237 | data QueryParam | 242 | data QueryParam |
238 | = ParamInfoHash | 243 | = ParamInfoHash |