]> git.rkrishnan.org Git - functorrent.git/blob - src/FuncTorrent/Network.hs
Misc fixes to http tracker.
[functorrent.git] / src / FuncTorrent / Network.hs
1 {-
2  - Copyright (C) 2015-2016 Ramakrishnan Muthukrishnan <ram@rkrishnan.org>
3  -
4  - This file is part of FuncTorrent.
5  -
6  - FuncTorrent is free software; you can redistribute it and/or modify
7  - it under the terms of the GNU General Public License as published by
8  - the Free Software Foundation; either version 3 of the License, or
9  - (at your option) any later version.
10  -
11  - FuncTorrent is distributed in the hope that it will be useful,
12  - but WITHOUT ANY WARRANTY; without even the implied warranty of
13  - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14  - GNU General Public License for more details.
15  -
16  - You should have received a copy of the GNU General Public License
17  - along with FuncTorrent; if not,  see <http://www.gnu.org/licenses/>
18  -}
19
20 {-# LANGUAGE OverloadedStrings #-}
21
22 module FuncTorrent.Network
23     (sendGetRequest
24     , mkParams
25     ) where
26
27 import Prelude hiding (concat)
28
29 import Data.ByteString (ByteString)
30 import Data.ByteString.Char8 as BC (pack, unpack, concat, intercalate)
31 import Network.HTTP (simpleHTTP, defaultGETRequest_, getResponseBody)
32 import Network.URI (parseURI)
33
34 -- | Make a query string from a alist of k, v
35 -- TODO: Url encode each argument
36 mkParams :: [(String, ByteString)] -> ByteString
37 mkParams params = BC.intercalate "&" [concat [pack f, "=", s] | (f,s) <- params]
38
39 sendGetRequest :: String -> [(String, ByteString)] -> IO ByteString
40 sendGetRequest url args = simpleHTTP (defaultGETRequest_ url') >>= getResponseBody
41     where url' = case parseURI url'' of
42                    Just x -> x
43                    _ -> error $ "Bad tracker URL: " ++ (show url'')
44           qstr = mkParams args
45           url'' = unpack $ concat [pack url, "?", qstr]