add UrlOptions sum type

1 files changed, 36 insertions, 23 deletions

diff --git a/Utility/Url.hs b/Utility/Url.hs
index 49f25c371..3ab14ebe4 100644
--- a/Utility/Url.hs
+++ b/Utility/Url.hs
@@ -10,6 +10,7 @@
 module Utility.Url (
 	URLString,
 	UserAgent,
+	UrlOptions(..),
 	check,
 	checkBoth,
 	exists,
@@ -23,6 +24,7 @@ import Network.URI
 import qualified Network.Browser as Browser
 import Network.HTTP
 import Data.Either
+import Data.Default
 
 import qualified Build.SysConfig
 
@@ -32,14 +34,24 @@ type Headers = [String]
 
 type UserAgent = String
 
+data UrlOptions = UrlOptions
+	{ userAgent :: Maybe UserAgent
+	, reqHeaders :: Headers
+	, reqParams :: [CommandParam]
+	}
+
+instance Default UrlOptions
+  where
+	def = UrlOptions Nothing [] []
+
 {- Checks that an url exists and could be successfully downloaded,
  - also checking that its size, if available, matches a specified size. -}
-checkBoth :: URLString -> Headers -> [CommandParam] -> Maybe Integer -> Maybe UserAgent -> IO Bool
-checkBoth url headers options expected_size ua = do
-	v <- check url headers options expected_size ua
+checkBoth :: URLString -> Maybe Integer -> UrlOptions -> IO Bool
+checkBoth url expected_size uo = do
+	v <- check url expected_size uo
 	return (fst v && snd v)
-check :: URLString -> Headers -> [CommandParam] -> Maybe Integer -> Maybe UserAgent -> IO (Bool, Bool)
-check url headers options expected_size = handle <$$> exists url headers options
+check :: URLString -> Maybe Integer -> UrlOptions -> IO (Bool, Bool)
+check url expected_size = handle <$$> exists url
   where
 	handle (False, _) = (False, False)
 	handle (True, Nothing) = (True, True)
@@ -55,8 +67,8 @@ check url headers options expected_size = handle <$$> exists url headers options
  - Uses curl otherwise, when available, since curl handles https better
  - than does Haskell's Network.Browser.
  -}
-exists :: URLString -> Headers -> [CommandParam] -> Maybe UserAgent -> IO (Bool, Maybe Integer)
-exists url headers options ua = case parseURIRelaxed url of
+exists :: URLString -> UrlOptions -> IO (Bool, Maybe Integer)
+exists url uo = case parseURIRelaxed url of
 	Just u
 		| uriScheme u == "file:" -> do
 			s <- catchMaybeIO $ getFileStatus (unEscapeString $ uriPath u)
@@ -70,7 +82,7 @@ exists url headers options ua = case parseURIRelaxed url of
 					Just ('2':_:_) -> return (True, extractsize output)
 					_ -> dne
 			else do
-				r <- request u headers HEAD ua
+				r <- request u HEAD uo
 				case rspCode r of
 					(2,_,_) -> return (True, size r)
 					_ -> return (False, Nothing)
@@ -78,12 +90,12 @@ exists url headers options ua = case parseURIRelaxed url of
   where
 	dne = return (False, Nothing)
 
-	curlparams = addUserAgent ua $
+	curlparams = addUserAgent uo $
 		[ Param "-s"
 		, Param "--head"
 		, Param "-L", Param url
 		, Param "-w", Param "%{http_code}"
-		] ++ concatMap (\h -> [Param "-H", Param h]) headers ++ options
+		] ++ concatMap (\h -> [Param "-H", Param h]) (reqHeaders uo) ++ (reqParams uo)
 
 	extractsize s = case lastMaybe $ filter ("Content-Length:" `isPrefixOf`) (lines s) of
 		Just l -> case lastMaybe $ words l of
@@ -94,9 +106,10 @@ exists url headers options ua = case parseURIRelaxed url of
 	size = liftM Prelude.read . lookupHeader HdrContentLength . rspHeaders
 
 -- works for both wget and curl commands
-addUserAgent :: Maybe UserAgent -> [CommandParam] -> [CommandParam]
-addUserAgent Nothing ps = ps
-addUserAgent (Just ua) ps = ps ++ [Param "--user-agent", Param ua] 
+addUserAgent :: UrlOptions -> [CommandParam] -> [CommandParam]
+addUserAgent uo ps = case userAgent uo of
+	Nothing -> ps
+	Just ua -> ps ++ [Param "--user-agent", Param ua] 
 
 {- Used to download large files, such as the contents of keys.
  -
@@ -105,15 +118,15 @@ addUserAgent (Just ua) ps = ps ++ [Param "--user-agent", Param ua]
  - would not be appropriate to test at configure time and build support
  - for only one in.
  -}
-download :: URLString -> Headers -> [CommandParam] -> FilePath -> Maybe UserAgent -> IO Bool
+download :: URLString -> FilePath -> UrlOptions -> IO Bool
 download = download' False
 
 {- No output, even on error. -}
-downloadQuiet :: URLString -> Headers -> [CommandParam] -> FilePath -> Maybe UserAgent -> IO Bool
+downloadQuiet :: URLString -> FilePath -> UrlOptions -> IO Bool
 downloadQuiet = download' True
 
-download' :: Bool -> URLString -> Headers -> [CommandParam] -> FilePath -> Maybe UserAgent -> IO Bool
-download' quiet url headers options file ua = 
+download' :: Bool -> URLString -> FilePath -> UrlOptions -> IO Bool
+download' quiet url file uo = 
 	case parseURIRelaxed url of
 		Just u
 			| uriScheme u == "file:" -> do
@@ -124,7 +137,7 @@ download' quiet url headers options file ua =
 			| otherwise -> ifM (inPath "wget") (wget , curl)
 		_ -> return False
   where
-	headerparams = map (\h -> Param $ "--header=" ++ h) headers
+	headerparams = map (\h -> Param $ "--header=" ++ h) (reqHeaders uo)
 	wget = go "wget" $ headerparams ++ quietopt "-q" ++ wgetparams
 	{- Regular wget needs --clobber to continue downloading an existing
 	 - file. On Android, busybox wget is used, which does not
@@ -142,7 +155,7 @@ download' quiet url headers options file ua =
 	curl = go "curl" $ headerparams ++ quietopt "-s" ++
 		[Params "-f -L -C - -# -o"]
 	go cmd opts = boolSystem cmd $
-		addUserAgent ua $ options++opts++[File file, File url]
+		addUserAgent uo $ reqParams uo++opts++[File file, File url]
 	quietopt s
 		| quiet = [Param s]
 		| otherwise = []
@@ -157,14 +170,14 @@ download' quiet url headers options file ua =
  - Unfortunately, does not handle https, so should only be used
  - when curl is not available.
  -}
-request :: URI -> Headers -> RequestMethod -> Maybe UserAgent -> IO (Response String)
-request url headers requesttype ua = go 5 url
+request :: URI -> RequestMethod -> UrlOptions -> IO (Response String)
+request url requesttype uo = go 5 url
   where
 	go :: Int -> URI -> IO (Response String)
 	go 0 _ = error "Too many redirects "
 	go n u = do
 		rsp <- Browser.browse $ do
-			maybe noop Browser.setUserAgent ua
+			maybe noop Browser.setUserAgent (userAgent uo)
 			Browser.setErrHandler ignore
 			Browser.setOutHandler ignore
 			Browser.setAllowRedirects False
@@ -174,7 +187,7 @@ request url headers requesttype ua = go 5 url
 			(3,0,x) | x /= 5 -> redir (n - 1) u rsp
 			_ -> return rsp
 	addheaders req = setHeaders req (rqHeaders req ++ userheaders)
-	userheaders = rights $ map parseHeader headers
+	userheaders = rights $ map parseHeader (reqHeaders uo)
 	ignore = const noop
 	redir n u rsp = case retrieveHeaders HdrLocation rsp of
 		[] -> return rsp