diff --git a/Annex/Url.hs b/Annex/Url.hs index 397a7910be..736905d330 100644 --- a/Annex/Url.hs +++ b/Annex/Url.hs @@ -26,7 +26,7 @@ getUserAgent = Annex.getState $ Just . fromMaybe defaultUserAgent . Annex.useragent getUrlOptions :: Annex U.UrlOptions -getUrlOptions = U.UrlOptions +getUrlOptions = mkUrlOptions <$> getUserAgent <*> headers <*> options diff --git a/Utility/Url.hs b/Utility/Url.hs index 073e368210..f7c028d8b2 100644 --- a/Utility/Url.hs +++ b/Utility/Url.hs @@ -10,7 +10,8 @@ module Utility.Url ( URLString, UserAgent, - UrlOptions(..), + UrlOptions, + mkUrlOptions, check, checkBoth, exists, @@ -35,30 +36,27 @@ type Headers = [String] type UserAgent = String -data BaseUrlOptions = BaseUrlOptions +data UrlOptions = UrlOptions { userAgent :: Maybe UserAgent , reqHeaders :: Headers , reqParams :: [CommandParam] - } - -instance Default BaseUrlOptions - where - def = UrlOptions Nothing [] [] - -data UrlOptions = UrlOptions - { urlOptions :: BaseUrlOptions , applyRequest :: Request -> Request } -mkUrlOptions :: BaseUrlOptions -> UrlOptions -mkUrlOptions uo = UrlOptions uo applyrequest +instance Default UrlOptions + where + def = UrlOptions Nothing [] [] id + +mkUrlOptions :: Maybe UserAgent -> Headers -> [CommandParam] -> UrlOptions +mkUrlOptions useragent reqheaders reqparams = + UrlOptions useragent reqheaders reqparams applyrequest where applyrequest = \r -> r { requestHeaders = requestHeaders r ++ addedheaders } addedheaders = uaheader ++ otherheaders - uaheader = case userAgent uo of + uaheader = case useragent of Nothing -> [] Just ua -> [(hUserAgent, B8.fromString ua)] - otherheaders = map toheader (reqHeaders uo) + otherheaders = map toheader reqheaders toheader s = let (h, v) = separate (== ':') s h' = CI.mk (B8.fromString h) @@ -67,7 +65,7 @@ mkUrlOptions uo = UrlOptions uo applyrequest _ -> (h', B8.fromString v) addUserAgent :: UrlOptions -> [CommandParam] -> [CommandParam] -addUserAgent (UrlOptions uo) ps = case userAgent uo of +addUserAgent uo ps = case userAgent uo of Nothing -> ps -- --user-agent works for both wget and curl commands Just ua -> ps ++ [Param "--user-agent", Param ua]