@@ -1990,6 +1990,241 @@ module internal CookieHandling =
19901990 cookiesFromCookieContainer
19911991 | None -> cookiesFromCookieContainer
19921992
1993+ #if NET8_ 0_ OR_ GREATER
1994+ /// Internal HttpClient-based HTTP implementation for .NET 8+.
1995+ /// Uses a shared HttpClient with SocketsHttpHandler for proper connection pooling.
1996+ module internal HttpClientImpl =
1997+
1998+ open System.Net .Http
1999+ open System.Net .Http .Headers
2000+
2001+ // Shared HttpClient instance. SocketsHttpHandler is used for connection reuse
2002+ // to avoid socket exhaustion. UseCookies=false because we handle cookies manually.
2003+ let private handler =
2004+ let h = new SocketsHttpHandler()
2005+ h.PooledConnectionLifetime <- TimeSpan.FromMinutes( 2.0 )
2006+
2007+ h.AutomaticDecompression <-
2008+ DecompressionMethods.GZip
2009+ ||| DecompressionMethods.Deflate
2010+ ||| DecompressionMethods.Brotli
2011+
2012+ h.UseCookies <- false
2013+ h.AllowAutoRedirect <- true
2014+ h
2015+
2016+ let private sharedClient = new HttpClient( handler)
2017+
2018+ let private charsetRegex = Regex( " charset=([^;\s ]*)" , RegexOptions.Compiled)
2019+
2020+ let private getBodyEncoding ( contentType : string ) =
2021+ let m = charsetRegex.Match( contentType)
2022+
2023+ if m.Success then
2024+ try
2025+ Encoding.GetEncoding( m.Groups.[ 1 ]. Value)
2026+ with _ ->
2027+ HttpEncodings.PostDefaultEncoding
2028+ else
2029+ HttpEncodings.PostDefaultEncoding
2030+
2031+ let private encodeFormData ( query : string ) =
2032+ ( WebUtility.UrlEncode query) .Replace( " +" , " %20" )
2033+
2034+ /// Build an HttpContent from an HttpRequestBody and content-type override headers
2035+ let private buildContent ( body : HttpRequestBody ) ( contentTypeOverride : string option ) : HttpContent * string =
2036+ let defaultContentType , streamFactory =
2037+ match body with
2038+ | TextRequest text ->
2039+ HttpContentTypes.Text, ( fun ( e : Encoding ) -> new MemoryStream( e.GetBytes( text)) :> Stream)
2040+ | BinaryUpload bytes -> HttpContentTypes.Binary, ( fun _ -> new MemoryStream( bytes) :> Stream)
2041+ | FormValues values ->
2042+ let factory ( e : Encoding ) =
2043+ let encoded =
2044+ [ for k, v in values -> encodeFormData k + " =" + encodeFormData v ]
2045+ |> String.concat " &"
2046+
2047+ new MemoryStream( e.GetBytes( encoded)) :> Stream
2048+
2049+ HttpContentTypes.FormValues, factory
2050+ | Multipart( boundary, parts) -> HttpContentTypes.Multipart( boundary), writeMultipart boundary parts
2051+ | MultipartFormData( boundary, parts) ->
2052+ let fileParts =
2053+ parts
2054+ |> Seq.map ( fun p ->
2055+ match p with
2056+ | FormValue( formField, value) ->
2057+ MultipartFileItem( formField, None, None, new MemoryStream( Encoding.UTF8.GetBytes( value)))
2058+ | FileValue item -> item)
2059+
2060+ HttpContentTypes.Multipart( boundary), writeMultipartFileItem boundary fileParts
2061+
2062+ let effectiveContentType = defaultArg contentTypeOverride defaultContentType
2063+ let encoding = getBodyEncoding effectiveContentType
2064+ let stream = streamFactory encoding
2065+ let content = new StreamContent( stream)
2066+ // Use TryAddWithoutValidation to avoid parsing issues with multipart boundaries etc.
2067+ content.Headers.TryAddWithoutValidation( " Content-Type" , effectiveContentType)
2068+ |> ignore
2069+
2070+ content, effectiveContentType
2071+
2072+ let innerRequestAsync
2073+ toHttpResponse
2074+ ( uri : Uri )
2075+ ( method : string )
2076+ ( headers : ( string * string ) list )
2077+ ( body : HttpRequestBody option )
2078+ ( cookies : seq < string * string > option )
2079+ ( cookieContainer : CookieContainer )
2080+ ( addCookiesToCookieContainer : bool )
2081+ ( silentHttpErrors : bool option )
2082+ ( silentCookieErrors : bool option )
2083+ ( responseEncodingOverride : string option )
2084+ ( timeout : int option )
2085+ =
2086+ async {
2087+ use req = new HttpRequestMessage( HttpMethod( method), uri)
2088+
2089+ // Enforce the same "no duplicate headers" invariant as the HttpWebRequest path
2090+ HttpHelpers.checkForRepeatedHeaders [] headers
2091+
2092+ // Separate content-type from other headers (content-type goes on content, not request)
2093+ let contentTypeOverride =
2094+ headers
2095+ |> List.tryFind ( fun ( h , _ ) -> h.Equals( " content-type" , StringComparison.OrdinalIgnoreCase))
2096+ |> Option.map snd
2097+
2098+ // Build and attach body content
2099+ match body with
2100+ | Some b ->
2101+ let content , _ = buildContent b contentTypeOverride
2102+ req.Content <- content
2103+ | None -> ()
2104+
2105+ // Set request headers (skip Content-* headers when we have a body, those go on content)
2106+ for header, value in headers do
2107+ let isContentHeader =
2108+ header.StartsWith( " content-" , StringComparison.OrdinalIgnoreCase)
2109+
2110+ if isContentHeader then
2111+ if not ( isNull req.Content) then
2112+ req.Content.Headers.TryAddWithoutValidation( header, value) |> ignore
2113+ else
2114+ req.Headers.TryAddWithoutValidation( header, value) |> ignore
2115+
2116+ // Manually set Cookie header (UseCookies=false means the handler won't do this)
2117+ let cookiesFromContainer = cookieContainer.GetCookies( uri) |> Seq.cast< Cookie>
2118+
2119+ let allCookieParts =
2120+ [ for c in cookiesFromContainer -> sprintf " %s =%s " c.Name c.Value
2121+ match cookies with
2122+ | Some cs -> for name, value in cs -> sprintf " %s =%s " name value
2123+ | None -> () ]
2124+
2125+ if not allCookieParts.IsEmpty then
2126+ req.Headers.TryAddWithoutValidation( " Cookie" , String.concat " ; " allCookieParts)
2127+ |> ignore
2128+
2129+ // Send request with optional timeout
2130+ use cts =
2131+ match timeout with
2132+ | Some ms -> new CancellationTokenSource( ms)
2133+ | None -> new CancellationTokenSource()
2134+
2135+ let! response =
2136+ async {
2137+ try
2138+ return !
2139+ sharedClient.SendAsync( req, HttpCompletionOption.ResponseHeadersRead, cts.Token)
2140+ |> Async.AwaitTask
2141+ with : ? OperationCanceledException ->
2142+ // Convert timeout to WebException for backward compatibility
2143+ raise (
2144+ WebException(
2145+ " Timeout exceeded while getting response" ,
2146+ null ,
2147+ WebExceptionStatus.Timeout,
2148+ null
2149+ )
2150+ )
2151+
2152+ return Unchecked.defaultof<_>
2153+ }
2154+
2155+ // Raise on HTTP error codes unless silentHttpErrors is set
2156+ let isSilent = defaultArg silentHttpErrors false
2157+
2158+ if not isSilent && int response.StatusCode >= 400 then
2159+ let! bodyText = response.Content.ReadAsStringAsync( cts.Token) |> Async.AwaitTask
2160+
2161+ let msg =
2162+ if String.IsNullOrEmpty bodyText then
2163+ sprintf " The remote server returned an error: (%d )" ( int response.StatusCode)
2164+ else
2165+ sprintf
2166+ " The remote server returned an error: (%d )\n Response from %s :\n %s "
2167+ ( int response.StatusCode)
2168+ uri.OriginalString
2169+ bodyText
2170+
2171+ failwith msg
2172+
2173+ // Build response headers map (combining request and content headers)
2174+ let respHeaders =
2175+ [ for h in response.Headers do
2176+ yield h.Key, String.concat " , " h.Value
2177+ for h in response.Content.Headers do
2178+ yield h.Key, String.concat " , " h.Value ]
2179+ |> Map.ofList
2180+
2181+ // Determine the final URI (after any redirects)
2182+ let responseUri =
2183+ if
2184+ not ( isNull response.RequestMessage)
2185+ && not ( isNull response.RequestMessage.RequestUri)
2186+ then
2187+ response.RequestMessage.RequestUri
2188+ else
2189+ uri
2190+
2191+ // Handle cookies from Set-Cookie header
2192+ let responseCookies =
2193+ CookieHandling.getCookiesAndManageCookieContainer
2194+ uri
2195+ responseUri
2196+ respHeaders
2197+ cookieContainer
2198+ addCookiesToCookieContainer
2199+ ( defaultArg silentCookieErrors false )
2200+
2201+ let contentTypeHeader =
2202+ match response.Content.Headers.ContentType with
2203+ | null -> " application/octet-stream"
2204+ | ct -> ct.ToString()
2205+
2206+ let statusCode = int response.StatusCode
2207+
2208+ let characterSet =
2209+ match response.Content.Headers.ContentType with
2210+ | null -> " "
2211+ | ct -> if isNull ct.CharSet then " " else ct.CharSet
2212+
2213+ let stream = response.Content.ReadAsStream()
2214+
2215+ return !
2216+ toHttpResponse
2217+ responseUri.OriginalString
2218+ statusCode
2219+ contentTypeHeader
2220+ characterSet
2221+ responseEncodingOverride
2222+ responseCookies
2223+ respHeaders
2224+ stream
2225+ }
2226+ #endif
2227+
19932228/// Utilities for working with network via HTTP. Includes methods for downloading
19942229/// resources with specified headers, query parameters and HTTP body
19952230[<AbstractClass>]
@@ -2012,7 +2247,7 @@ type Http private () =
20122247 + if url.Contains " ?" then " &" else " ?"
20132248 + String.concat " &" [ for k, v in query -> Uri.EscapeDataString k + " =" + Uri.EscapeDataString v ]
20142249
2015- static member private InnerRequest
2250+ static member private InnerRequestWebRequest
20162251 (
20172252 url : string ,
20182253 toHttpResponse ,
@@ -2168,6 +2403,84 @@ type Http private () =
21682403 stream
21692404 })
21702405
2406+ static member private InnerRequest
2407+ (
2408+ url : string ,
2409+ toHttpResponse ,
2410+ [<Optional>] ? query ,
2411+ [<Optional>] ? headers : seq < _ >,
2412+ [<Optional>] ? httpMethod ,
2413+ [<Optional>] ? body ,
2414+ [<Optional>] ? cookies : seq < _ >,
2415+ [<Optional>] ? cookieContainer ,
2416+ [<Optional>] ? silentHttpErrors ,
2417+ [<Optional>] ? silentCookieErrors ,
2418+ [<Optional>] ? responseEncodingOverride ,
2419+ [<Optional>] ? customizeHttpRequest ,
2420+ [<Optional>] ? timeout
2421+ ) =
2422+ #if NET8_ 0_ OR_ GREATER
2423+ // On .NET 8+, use HttpClient for connection pooling and to avoid socket
2424+ // exhaustion. Fall back to HttpWebRequest when customizeHttpRequest is
2425+ // provided, to preserve backward compatibility with that callback.
2426+ if customizeHttpRequest.IsNone then
2427+ let uri = Http.AppendQueryToUrl( url, defaultArg query []) |> Uri
2428+ let headersList = defaultArg ( Option.map List.ofSeq headers) []
2429+ let defaultMethod = if body.IsSome then HttpMethod.Post else HttpMethod.Get
2430+ let methodStr = ( defaultArg httpMethod defaultMethod) .ToString()
2431+
2432+ let addCookiesFromHeadersToCookieContainer , cookieContainer =
2433+ match cookieContainer with
2434+ | Some x -> false , x
2435+ | None -> true , CookieContainer()
2436+
2437+ HttpClientImpl.innerRequestAsync
2438+ toHttpResponse
2439+ uri
2440+ methodStr
2441+ headersList
2442+ body
2443+ cookies
2444+ cookieContainer
2445+ addCookiesFromHeadersToCookieContainer
2446+ silentHttpErrors
2447+ silentCookieErrors
2448+ responseEncodingOverride
2449+ timeout
2450+ else
2451+ Http.InnerRequestWebRequest(
2452+ url,
2453+ toHttpResponse,
2454+ ?query = query,
2455+ ?headers = headers,
2456+ ?httpMethod = httpMethod,
2457+ ?body = body,
2458+ ?cookies = cookies,
2459+ ?cookieContainer = cookieContainer,
2460+ ?silentHttpErrors = silentHttpErrors,
2461+ ?silentCookieErrors = silentCookieErrors,
2462+ ?responseEncodingOverride = responseEncodingOverride,
2463+ ?customizeHttpRequest = customizeHttpRequest,
2464+ ?timeout = timeout
2465+ )
2466+ #else
2467+ Http.InnerRequestWebRequest(
2468+ url,
2469+ toHttpResponse,
2470+ ?query = query,
2471+ ?headers = headers,
2472+ ?httpMethod = httpMethod,
2473+ ?body = body,
2474+ ?cookies = cookies,
2475+ ?cookieContainer = cookieContainer,
2476+ ?silentHttpErrors = silentHttpErrors,
2477+ ?silentCookieErrors = silentCookieErrors,
2478+ ?responseEncodingOverride = responseEncodingOverride,
2479+ ?customizeHttpRequest = customizeHttpRequest,
2480+ ?timeout = timeout
2481+ )
2482+ #endif
2483+
21712484 /// Download an HTTP web resource from the specified URL asynchronously
21722485 /// (allows specifying query string parameters and HTTP headers including
21732486 /// headers that have to be handled specially - such as Accept, Content-Type & Referer)
0 commit comments