add UrlOptions sum type

1 files changed, 20 insertions, 5 deletions

diff --git a/Annex/Url.hs b/Annex/Url.hs
index 0401ffe07..397a7910b 100644
--- a/Annex/Url.hs
+++ b/Annex/Url.hs
@@ -1,13 +1,15 @@
-{- Url downloading, with git-annex user agent.
+{- Url downloading, with git-annex user agent and configured http
+ - headers and wget/curl options.
  -
- - Copyright 2013 Joey Hess <joey@kitenet.net>
+ - Copyright 2013-2014 Joey Hess <joey@kitenet.net>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
 module Annex.Url (
 	module U,
-	withUserAgent,
+	withUrlOptions,
+	getUrlOptions,
 	getUserAgent,
 ) where
 
@@ -23,5 +25,18 @@ getUserAgent :: Annex (Maybe U.UserAgent)
 getUserAgent = Annex.getState $ 
 	Just . fromMaybe defaultUserAgent . Annex.useragent
 
-withUserAgent :: (Maybe U.UserAgent -> IO a) -> Annex a
-withUserAgent a = liftIO . a =<< getUserAgent
+getUrlOptions :: Annex U.UrlOptions
+getUrlOptions = U.UrlOptions
+	<$> getUserAgent
+	<*> headers
+	<*> options
+  where
+	headers = do
+		v <- annexHttpHeadersCommand <$> Annex.getGitConfig
+		case v of
+			Just cmd -> lines <$> liftIO (readProcess "sh" ["-c", cmd])
+			Nothing -> annexHttpHeaders <$> Annex.getGitConfig
+	options = map Param . annexWebOptions <$> Annex.getGitConfig
+
+withUrlOptions :: (U.UrlOptions -> IO a) -> Annex a
+withUrlOptions a = liftIO . a =<< getUrlOptions