Make network request return ByteString

[functorrent.git] / src / Tracker.hs

diff --git a/src/Tracker.hs b/src/Tracker.hs
index 68cf28c731f2818c291fbc0482961fc3fccea183..6c558e5798e6df86358a790398bc1f78d15f939a 100644 (file)
--- a/src/Tracker.hs
+++ b/src/Tracker.hs
@@ -1,57 +1,52 @@
 module Tracker where
 
-import qualified Data.ByteString.Char8 as BC
-import qualified Data.Map as M
-import qualified Data.List as List
-import qualified Network.HTTP as HTTP
-import qualified Bencode as Benc
-import qualified Crypto.Hash.SHA1 as SHA1
-import qualified Data.ByteString.Base16 as B16
-import qualified Utils as U
-import Data.Char
--- import Network.HTTP
+import Prelude hiding (lookup)
+
+import Bencode (BVal(..), InfoDict, encode)
+import Crypto.Hash.SHA1 (hash)
+import Data.ByteString.Char8 (ByteString, pack, unpack)
+import Data.Char (chr)
+import Data.List (intercalate)
+import Data.Maybe (fromJust)
+import Data.Map as M (Map, (!))
+import Network.HTTP (simpleHTTP, defaultGETRequest_, getResponseBody)
+import Network.HTTP.Base (urlEncode)
+import Network.URI (parseURI)
+import Utils (splitN)
+import qualified Data.ByteString.Base16 as B16 (encode)
 
 type Url = String
 
-
--- | urlEncode
+-- | urlEncodeHash
 --
--- >>> urlEncode $ BC.pack "123456789abcdef123456789abcdef123456789a"
+-- >>> urlEncodeHash $ pack "123456789abcdef123456789abcdef123456789a"
 -- "%124Vx%9a%bc%de%f1%23Eg%89%ab%cd%ef%124Vx%9a"
-urlEncode :: BC.ByteString -> String
-urlEncode bs = concatMap (encode . BC.unpack) (U.splitN 2 bs)
-  where encode b@(c1 : c2 : []) = let c =  chr (read ("0x" ++ b))
-                                  in
-                                   escape c c1 c2
-        encode _ = ""
+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]
-          where nonSpecialChars = ['A'..'Z'] ++
-                                  ['a'..'z'] ++
-                                  ['0'..'9'] ++
-                                  "-_.~"
-
-infoHash :: M.Map Benc.BVal Benc.BVal -> BC.ByteString
-infoHash m = let info = m M.! Benc.Bstr (BC.pack "info")
-             in (B16.encode . SHA1.hash . BC.pack . Benc.encode) info
-
-peerHash :: String -> BC.ByteString
-peerHash = B16.encode . SHA1.hash . BC.pack
-
-prepareRequest :: Benc.BVal -> String -> Integer -> String
-prepareRequest (Benc.Bdict d) peer_id length =
-  let p = [("info_hash", urlEncode (infoHash d)),
-           ("peer_id", urlEncode (peerHash peer_id)),
+
+        nonSpecialChars = ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "-_.~"
+
+infoHash :: Map BVal BVal -> ByteString
+infoHash m = let info = m ! Bstr (pack "info")
+             in (hash . pack . encode) info
+
+prepareRequest :: InfoDict -> String -> Integer -> String
+prepareRequest d peer_id len =
+  let p = [("info_hash", urlEncodeHash ((B16.encode . infoHash) d)),
+           ("peer_id", urlEncode peer_id),
            ("port", "6881"),
            ("uploaded", "0"),
            ("downloaded", "0"),
-           ("left", show length),
+           ("left", show len),
            ("compact", "1"),
            ("event", "started")]
-  in
-   List.intercalate "&" [f ++ "=" ++ s | (f,s) <- p]
+  in intercalate "&" [f ++ "=" ++ s | (f,s) <- p]
 
-connect :: Url -> String -> IO String
-connect baseurl qstr = let url = baseurl ++ "?" ++ qstr
-                       in HTTP.simpleHTTP (HTTP.getRequest url) >>=
-                          HTTP.getResponseBody
+connect :: Url -> String -> IO ByteString
+connect baseurl qstr = simpleHTTP (defaultGETRequest_ url) >>= getResponseBody
+    where url = fromJust . parseURI $ (baseurl ++ "?" ++ qstr)