diff --git a/src/FsHttp/Defaults.fs b/src/FsHttp/Defaults.fs index 747cd6bf..83deba7f 100644 --- a/src/FsHttp/Defaults.fs +++ b/src/FsHttp/Defaults.fs @@ -10,40 +10,68 @@ open System.Text.Json let defaultJsonDocumentOptions = JsonDocumentOptions() let defaultJsonSerializerOptions = JsonSerializerOptions JsonSerializerDefaults.Web -let defaultHttpClientFactory (config: Config) = - let handler = +let defaultDecompressionMethods = [ DecompressionMethods.All ] + +// A long-lived shared handler used when no handler customisations are required. +// Reusing a single SocketsHttpHandler preserves the TCP connection pool across requests, +// preventing SNAT port exhaustion on Azure and similar environments (issue #198). +// The HttpClient created per-request uses disposeHandler=false so the pool is never torn down. +let private sharedDefaultHandler = + lazy ( + let decompression = defaultDecompressionMethods |> List.fold (fun c n -> c ||| n) DecompressionMethods.None new SocketsHttpHandler( - UseCookies = false, - PooledConnectionLifetime = TimeSpan.FromMinutes 5.0) - let ignoreSslIssues = - match config.certErrorStrategy with - | Default -> false - | AlwaysAccept -> true - if ignoreSslIssues then - do handler.SslOptions <- - let options = Security.SslClientAuthenticationOptions() - let callback = Security.RemoteCertificateValidationCallback(fun sender cert chain errors -> true) - do options.RemoteCertificateValidationCallback <- callback - options - do handler.AutomaticDecompression <- - config.defaultDecompressionMethods - |> List.fold (fun c n -> c ||| n) DecompressionMethods.None - let handler = config.httpClientHandlerTransformers |> List.fold (fun c n -> n c) handler + UseCookies = false, + PooledConnectionLifetime = TimeSpan.FromMinutes 5.0, + AutomaticDecompression = decompression)) - match config.proxy with - | Some proxy -> - let webProxy = WebProxy(proxy.url) +let private canUseSharedHandler (config: Config) = + config.certErrorStrategy = Default + && List.isEmpty config.httpClientHandlerTransformers + && config.proxy.IsNone + && config.defaultDecompressionMethods = defaultDecompressionMethods + +let defaultHttpClientFactory (config: Config) = + let handler, disposeHandler = + if canUseSharedHandler config then + // Return the shared handler without ownership. + // The per-request HttpClient is a lightweight wrapper; only the handler holds connections. + sharedDefaultHandler.Value, false + else + let handler = + new SocketsHttpHandler( + UseCookies = false, + PooledConnectionLifetime = TimeSpan.FromMinutes 5.0) + let ignoreSslIssues = + match config.certErrorStrategy with + | Default -> false + | AlwaysAccept -> true + if ignoreSslIssues then + do handler.SslOptions <- + let options = Security.SslClientAuthenticationOptions() + let callback = Security.RemoteCertificateValidationCallback(fun sender cert chain errors -> true) + do options.RemoteCertificateValidationCallback <- callback + options + do handler.AutomaticDecompression <- + config.defaultDecompressionMethods + |> List.fold (fun c n -> c ||| n) DecompressionMethods.None + let handler = config.httpClientHandlerTransformers |> List.fold (fun c n -> n c) handler - match proxy.credentials with - | Some cred -> - webProxy.UseDefaultCredentials <- false - webProxy.Credentials <- cred - | None -> webProxy.UseDefaultCredentials <- true + match config.proxy with + | Some proxy -> + let webProxy = WebProxy(proxy.url) - handler.Proxy <- webProxy - | None -> () + match proxy.credentials with + | Some cred -> + webProxy.UseDefaultCredentials <- false + webProxy.Credentials <- cred + | None -> webProxy.UseDefaultCredentials <- true - let client = new HttpClient(handler) + handler.Proxy <- webProxy + | None -> () + + handler, true + + let client = new HttpClient(handler, disposeHandler) do config.timeout |> Option.iter (fun timeout -> client.Timeout <- timeout) client @@ -52,9 +80,7 @@ let defaultHeadersAndBodyPrintMode = { maxLength = Some 7000 } -let defaultDecompressionMethods = [ DecompressionMethods.All ] - -let defaultConfig = +let defaultConfig = { timeout = None defaultDecompressionMethods = defaultDecompressionMethods