- (Bdict body) = resp
-
-toInt :: String -> Integer
-toInt = read
-
-makePeer :: ByteString -> Peer
-makePeer peer = Peer "" (toIP ip') (toPort port')
- where (ip', port') = splitAt 4 peer
-
-toPort :: ByteString -> Port
-toPort = read . ("0x" ++) . unpack . B16.encode
-
-toIP :: ByteString -> IP
-toIP = Data.List.intercalate "." .
- map (show . toInt . ("0x" ++) . unpack) .
- splitN 2 . B16.encode
-
---- | URL encode hash as per RFC1738
---- TODO: Add tests
---- REVIEW: Why is this not written in terms of `Network.HTTP.Base.urlEncode` or
---- equivalent library function?
-urlEncodeHash :: ByteString -> String
-urlEncodeHash bs = concatMap (encode' . unpack) (splitN 2 bs)
- where encode' b@[c1, c2] = let c = chr (read ("0x" ++ b))
- in escape c c1 c2
- encode' _ = ""
- escape i c1 c2 | i `elem` nonSpecialChars = [i]
- | otherwise = "%" ++ [c1] ++ [c2]
-
- nonSpecialChars = ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "-_.~"
-
--- | Make arguments that should be posted to tracker.
--- This is a separate pure function for testability.
-mkArgs :: PortNumber -> String -> Integer -> Integer -> Metainfo -> [(String, ByteString)]
-mkArgs port peer_id up down m =
- let fileSize = lengthInBytes $ info m
- bytesLeft = fileSize - down
- in
- [("info_hash", pack . urlEncodeHash . B16.encode . infoHash $ m),
- ("peer_id", pack . urlEncode $ peer_id),
- ("port", pack $ show port),
- ("uploaded", pack $ show up),
- ("downloaded", pack $ show down),
- ("left", pack $ show bytesLeft),
- ("compact", "1"),
- ("event", "started")]
-
-trackerLoop :: PortNumber -> String -> Metainfo -> TState -> IO ByteString
-trackerLoop port peerId m st = do
- up <- readMVar $ uploaded st
- down <- readMVar $ downloaded st
- resp <- sendGetRequest (head . announceList $ m) $ mkArgs port peerId up down m
- case Benc.decode resp of
- Left e -> return $ pack (show e)
- Right trackerInfo ->
- case mkTrackerResponse trackerInfo of
- Left e -> return e
- Right tresp -> do
- _ <- threadDelay $ fromIntegral (interval tresp)
- _ <- putMVar (connectedPeers st) (peers tresp)
- trackerLoop port peerId m st
-
--- udp tracker
-getResponse :: Handle -> IO UDPResponse
-getResponse h = do
- -- connect packet is 16 bytes long
- -- announce packet is atleast 20 bytes long
- bs <- hGet h (16*1024)
- return $ decode $ fromStrict bs
-
-sendRequest :: Handle -> UDPRequest -> IO ()
-sendRequest h req = hPut h bsReq
- where bsReq = toStrict $ encode req