diff options
Diffstat (limited to 'src/Network/BitTorrent')
-rw-r--r-- | src/Network/BitTorrent/Tracker/UDP.hs | 42 |
1 files changed, 14 insertions, 28 deletions
diff --git a/src/Network/BitTorrent/Tracker/UDP.hs b/src/Network/BitTorrent/Tracker/UDP.hs index f6469a18..8d43d7b8 100644 --- a/src/Network/BitTorrent/Tracker/UDP.hs +++ b/src/Network/BitTorrent/Tracker/UDP.hs | |||
@@ -123,11 +123,11 @@ instance Serialize (Transaction Request) where | |||
123 | put connectId | 123 | put connectId |
124 | put transIdQ | 124 | put transIdQ |
125 | 125 | ||
126 | Announce query -> do | 126 | Announce ann -> do |
127 | put connIdQ | 127 | put connIdQ |
128 | put announceId | 128 | put announceId |
129 | put transIdQ | 129 | put transIdQ |
130 | put query | 130 | put ann |
131 | 131 | ||
132 | Scrape hashes -> do | 132 | Scrape hashes -> do |
133 | put connIdQ | 133 | put connIdQ |
@@ -136,23 +136,18 @@ instance Serialize (Transaction Request) where | |||
136 | forM_ hashes put | 136 | forM_ hashes put |
137 | 137 | ||
138 | get = do | 138 | get = do |
139 | cid <- get | 139 | cid <- get |
140 | mid <- getWord32be | 140 | mid <- getWord32be |
141 | tid <- get | 141 | TransactionQ cid <$> get <*> getBody mid |
142 | bod <- getBody mid | ||
143 | |||
144 | return $ TransactionQ { | ||
145 | connIdQ = cid | ||
146 | , transIdQ = tid | ||
147 | , request = bod | ||
148 | } | ||
149 | where | 142 | where |
150 | getBody :: MessageId -> Get Request | 143 | getBody :: MessageId -> Get Request |
151 | getBody msgId | 144 | getBody msgId |
152 | | msgId == connectId = pure Connect | 145 | | msgId == connectId = pure Connect |
153 | | msgId == announceId = Announce <$> get | 146 | | msgId == announceId = Announce <$> get |
154 | | msgId == scrapeId = Scrape <$> many get | 147 | | msgId == scrapeId = Scrape <$> many get |
155 | | otherwise = fail "unknown message id" | 148 | | otherwise = fail errMsg |
149 | where | ||
150 | errMsg = "unknown request message id: " ++ show msgId | ||
156 | 151 | ||
157 | instance Serialize (Transaction Response) where | 152 | instance Serialize (Transaction Response) where |
158 | put TransactionR {..} = do | 153 | put TransactionR {..} = do |
@@ -179,27 +174,18 @@ instance Serialize (Transaction Response) where | |||
179 | 174 | ||
180 | 175 | ||
181 | get = do | 176 | get = do |
182 | -- cid <- get | 177 | mid <- getWord32be |
183 | mid <- getWord32be | 178 | TransactionR <$> get <*> getBody mid |
184 | tid <- get | ||
185 | bod <- getBody mid | ||
186 | |||
187 | return $ TransactionR | ||
188 | { transIdR = tid | ||
189 | , response = bod | ||
190 | } | ||
191 | where | 179 | where |
192 | getBody :: MessageId -> Get Response | 180 | getBody :: MessageId -> Get Response |
193 | getBody msgId | 181 | getBody msgId |
194 | | msgId == connectId = Connected <$> get | 182 | | msgId == connectId = Connected <$> get |
195 | | msgId == announceId = Announced <$> get | 183 | | msgId == announceId = Announced <$> get |
196 | | msgId == scrapeId = Scraped <$> many get | 184 | | msgId == scrapeId = Scraped <$> many get |
197 | | msgId == errorId = do | 185 | | msgId == errorId = (Failed . decodeUtf8) <$> get |
198 | bs <- get | 186 | | otherwise = fail msg |
199 | case decodeUtf8' bs of | 187 | where |
200 | Left ex -> fail (show ex) | 188 | msg = "unknown message response id: " ++ show msgId |
201 | Right msg -> return $ Failed msg | ||
202 | | otherwise = fail $ "unknown message id: " ++ show msgId | ||
203 | 189 | ||
204 | {----------------------------------------------------------------------- | 190 | {----------------------------------------------------------------------- |
205 | Connection | 191 | Connection |