3 files changed, 70 insertions(+), 45 deletions(-)

M ChangeLog.md
M hurl.cabal
M src/Network/URI/Fetch.hs

@@ 1,5 1,12 @@
 # Revision history for hurl
 
+## 2.1.0.1 -- 2021-03-09
+* Fixes a build failure.
+
+## 2.1.0.0
+* Added APIs for localizing MIMEtypes
+* Crash fixes
+
 ## 2.0.0.0 -- 2021-01-07
 * Fix several real & potential crashes
 * Expose APIs for querying localized labels for MIME types from the OS

@@ 10,7 10,7 @@ name:                hurl
 -- PVP summary:      +-+------- breaking API changes
 --                   | | +----- non-breaking API additions
 --                   | | | +--- code changes with no API change
-version:             2.1.0.0
+version:             2.1.0.1
 
 -- A short (one-line) description of the package.
 synopsis:            Haskell URL resolver

@@ 196,6 196,16 @@ mimeERR, htmlERR :: String
 mimeERR = "txt/x-error\t"
 htmlERR = "html/x-error\t"
 
+submitURL :: Session -> [String] -> URI -> Text -> String -> IO (URI, String, Either Text ByteString)
+#ifdef WITH_HTTP_URI
+submitURL session accept uri "POST" query | uriScheme uri `elem` ["http:", "https:"] =
+    fetchHTTPCached session accept uri $ \req -> req {
+            HTTP.method = "POST",
+            HTTP.requestBody = HTTP.RequestBodyBS $ C8.pack query
+        }
+#endif
+submitURL session mimes uri _method query = fetchURL' session mimes uri { uriQuery = '?':query }
+
 -- | As per `fetchURL`, but also returns the redirected URI.
 fetchURL' :: Session -> [String] -> URI -> IO (URI, String, Either Text ByteString)
 fetchURL' Session {redirectCount = 0, locale = locale'} _ uri =


@@ 248,50 258,8 @@ fetchURL' Session {aboutPages = pages} _ url@URI {uriScheme = "about:", uriPath 
         Right $ llookup path "" pages)
 
 #ifdef WITH_HTTP_URI
-fetchURL' session accept@(defaultMIME:_) uri | uriScheme uri `elem` ["http:", "https:"] = do
-    cached <- if cachingEnabled session then readCacheHTTP uri else return (Nothing, Nothing)
-    response <- case cached of
-        (Just (mime, body), Nothing) -> return $ Right (mime, body)
-        (cached, cachingHeaders) -> do
-            request <- HTTP.requestFromURI uri
-            response <- HTTP.httpLbs request {
-                    HTTP.cookieJar = Nothing, -- Will only be supported by Rhapsode when submitting a form.
-                    HTTP.requestHeaders = [
-                        ("Accept", C8.pack $ intercalate ", " accept),
-                        ("Accept-Language", C8.pack $ intercalate ", " $ locale session)
-                    ] ++ fromMaybe [] cachingHeaders,
-                    HTTP.redirectCount = 0
-                } $ managerHTTP session
-            case (
-                    HTTP.responseStatus response,
-                    HTTP.responseBody response,
-                    [val | ("content-type", val) <- HTTP.responseHeaders response]
-              ) of
-                (Status 304 _, _, _) | Just cached'@(_, body) <- cached -> do
-                    cacheHTTP uri $ response { HTTP.responseBody = body }
-                    return $ Right cached'
-                -- Manually handle redirects so the caller & HTTP cache gets the correct URI.
-                (Status code _, _, _) | code > 300 && code < 400,
-                        Just location <- lookup "location" $ HTTP.responseHeaders response,
-                        Just uri' <- parseURIReference $ C8.unpack location ->
-                    return $ Left $ relativeTo uri' uri
-                (Status _ msg, "", _) -> return $ Right (Txt.pack mimeERR, B.fromStrict msg)
-                (_, body, (mimetype:_)) -> do
-                    cacheHTTP uri response
-                    forkIO cleanCacheHTTP -- Try to keep diskspace down...
-
-                    let mime = Txt.toLower $ convertCharset "utf-8" mimetype
-                    return $ Right (mime, body)
-                (_, response, []) -> return $ Right (Txt.pack defaultMIME, response)
-
-    case response of
-        Left redirect ->
-            let session' = session { redirectCount = redirectCount session - 1 }
-            in fetchURL' session' accept redirect
-        Right (mime, body) ->
-            let mime' = L.map (Txt.unpack . Txt.strip) $ Txt.splitOn ";" mime
-            in return $ resolveCharset' uri mime' body
-  `catch` \e -> do return (uri, mimeERR, Left $ Txt.pack $ trans (locale session) $ Http e)
+fetchURL' session accept uri | uriScheme uri `elem` ["http:", "https:"] =
+    fetchHTTPCached session accept uri id
 #endif
 
 #ifdef WITH_GEMINI_URI


@@ 392,6 360,56 @@ dispatchByApp session@Session { locale = l } Application { appId = app} mime uri
 dispatchByApp _ _ _ _ = return False
 #endif
 
+#ifdef WITH_HTTP_URI
+fetchHTTPCached session accept@(defaultMIME:_) uri cb = do
+    cached <- if cachingEnabled session then readCacheHTTP uri else return (Nothing, Nothing)
+    response <- case cached of
+        (Just (mime, body), Nothing) -> return $ Right (mime, body)
+        (cached, cachingHeaders) -> do
+            request <- HTTP.requestFromURI uri
+            let request' = cb request {
+                HTTP.cookieJar = Nothing, -- Will only be supported by Rhapsode when submitting a form.
+                HTTP.requestHeaders = [
+                    ("Accept", C8.pack $ intercalate ", " accept),
+                    ("Accept-Language", C8.pack $ intercalate ", " $ locale session)
+                ] ++ fromMaybe [] cachingHeaders,
+                HTTP.redirectCount = 0
+            }
+            response <- HTTP.httpLbs request $ managerHTTP session
+            case (
+                    HTTP.responseStatus response,
+                    HTTP.responseBody response,
+                    [val | ("content-type", val) <- HTTP.responseHeaders response]
+              ) of
+                (Status 304 _, _, _) | Just cached'@(_, body) <- cached -> do
+                    cacheHTTP uri $ response { HTTP.responseBody = body }
+                    return $ Right cached'
+                -- Manually handle redirects so the caller & HTTP cache gets the correct URI.
+                (Status code _, _, _) | code > 300 && code < 400,
+                        Just location <- lookup "location" $ HTTP.responseHeaders response,
+                        Just uri' <- parseURIReference $ C8.unpack location ->
+                    return $ Left $ relativeTo uri' uri
+                (Status _ msg, "", _) -> return $ Right (Txt.pack mimeERR, B.fromStrict msg)
+                (_, body, (mimetype:_)) -> do
+                    cacheHTTP uri response
+                    forkIO cleanCacheHTTP -- Try to keep diskspace down...
+
+                    let mime = Txt.toLower $ convertCharset "utf-8" mimetype
+                    return $ Right (mime, body)
+                (_, response, []) -> return $ Right (Txt.pack defaultMIME, response)
+
+    case response of
+        Left redirect ->
+            let session' = session { redirectCount = redirectCount session - 1 }
+            in fetchURL' session' accept redirect
+        Right (mime, body) ->
+            let mime' = L.map (Txt.unpack . Txt.strip) $ Txt.splitOn ";" mime
+            in return $ resolveCharset' uri mime' body
+  `catch` \e -> do return (uri, mimeERR, Left $ Txt.pack $ trans (locale session) $ Http e)
+fetchHTTPCached session [] uri cb =
+    return (uri, mimeERR, Left $ Txt.pack $ trans (locale session) $ UnsupportedMIME "")
+#endif
+
 -- Downloads utilities
 -- | write download to a file in the given directory.
 saveDownload :: URI -> FilePath -> (URI, String, Either Text ByteString) -> IO URI