Refactor FsHttpUrl to FsHttpTarget and add header transformer

Author: SchlenkR

Directory.Build.props

@@ -1,7 +1,7 @@
 <Project>
 
   <PropertyGroup>
-    <Version>13.3.0</Version>
+    <Version>14.0.0</Version>
 
     <Authors>Ronald Schlenker</Authors>
     <Copyright>Copyright 2024 Ronald Schlenker</Copyright>
@@ -16,6 +16,14 @@
     <FsDocsReleaseNotesLink>https://www.nuget.org/packages/FsHttp#release-body-tab</FsDocsReleaseNotesLink>
 
     <PackageReleaseNotes>
+      v14.0.0
+      - (Breaking change) Renamed types in Domain:
+        BodyContent -> SinglepartContent
+        RequestContent -> BodyContent
+        FsHttpUrl -> FsHttpTarget
+      - (Breaking change) FsHttpUrl (now FsHttpTarget) and Header restructured: method, address and queryParams are now part of the FsHttpTarget type.
+      - Added `headerTransformers` to Config for better composability
+
       v13.3.0
       - (Breaking change) All `Response._TAsync` functions (task based) in F# require a CancellationToken now.
       - (Breaking change) Extension methods rework

docs/Composability.fsx

@@ -0,0 +1,15 @@
+(**
+---
+title: Composability
+category: Documentation
+categoryindex: 1
+index: 15
+---
+*)
+
+(**
+## Composability 
+
+TODO: Use transformHeader to pre-configure URLs
+
+*)

src/FsHttp/Defaults.fs

@@ -63,20 +63,22 @@ let defaultHeadersAndBodyPrintMode = {
 
 let defaultDecompressionMethods = [ DecompressionMethods.All ]
 
-let defaultConfig = {
-    timeout = None
-    defaultDecompressionMethods = defaultDecompressionMethods
-    printHint = {
-        requestPrintMode = HeadersAndBody(defaultHeadersAndBodyPrintMode)
-        responsePrintMode = HeadersAndBody(defaultHeadersAndBodyPrintMode)
+let defaultConfig = 
+    {
+        timeout = None
+        defaultDecompressionMethods = defaultDecompressionMethods
+        printHint = {
+            requestPrintMode = HeadersAndBody(defaultHeadersAndBodyPrintMode)
+            responsePrintMode = HeadersAndBody(defaultHeadersAndBodyPrintMode)
+        }
+        headerTransformers = []
+        httpMessageTransformers = []
+        httpClientHandlerTransformers = []
+        httpClientTransformers = []
+        httpClientFactory = defaultHttpClientFactory
+        httpCompletionOption = HttpCompletionOption.ResponseHeadersRead
+        proxy = None
+        certErrorStrategy = Default
+        bufferResponseContent = false
+        cancellationToken = Threading.CancellationToken.None
     }
-    httpMessageTransformers = []
-    httpClientHandlerTransformers = []
-    httpClientTransformers = []
-    httpClientFactory = defaultHttpClientFactory
-    httpCompletionOption = HttpCompletionOption.ResponseHeadersRead
-    proxy = None
-    certErrorStrategy = Default
-    bufferResponseContent = false
-    cancellationToken = Threading.CancellationToken.None
-}

src/FsHttp/Domain.fs

@@ -34,14 +34,13 @@ type Proxy = {
     credentials: System.Net.ICredentials option
 }
 
-type HttpClientHandlerTransformer = (System.Net.Http.SocketsHttpHandler -> System.Net.Http.SocketsHttpHandler)
-
-and Config = {
+type Config = {
     timeout: System.TimeSpan option
     defaultDecompressionMethods: System.Net.DecompressionMethods list
     printHint: PrintHint
+    headerTransformers: list<Header -> Header>
     httpMessageTransformers: list<System.Net.Http.HttpRequestMessage -> System.Net.Http.HttpRequestMessage>
-    httpClientHandlerTransformers: list<HttpClientHandlerTransformer>
+    httpClientHandlerTransformers: list<System.Net.Http.SocketsHttpHandler -> System.Net.Http.SocketsHttpHandler>
     httpClientTransformers: list<System.Net.Http.HttpClient -> System.Net.Http.HttpClient>
     httpCompletionOption: System.Net.Http.HttpCompletionOption
     proxy: Proxy option
@@ -52,46 +51,30 @@ and Config = {
     cancellationToken: CancellationToken
 }
 
-type ConfigTransformer = Config -> Config
+and ConfigTransformer = Config -> Config
 
-type PrintHintTransformer = PrintHint -> PrintHint
+and PrintHintTransformer = PrintHint -> PrintHint
 
-type FsHttpUrl = {
+and FsHttpTarget = {
+    method: System.Net.Http.HttpMethod option
     address: string option
-    additionalQueryParams: List<string * string>
+    additionalQueryParams: list<string * string>
 }
 
-type Header = {
-    method: System.Net.Http.HttpMethod option
+and Header = {
+    target: FsHttpTarget
     headers: Map<string, string>
     // We use a .Net type here, which we never do in other places.
     // Since Cookie is record style, I see no problem here.
     cookies: System.Net.Cookie list
 }
 
-type ContentData =
-    | TextContent of string
-    | BinaryContent of byte array
-    | StreamContent of System.IO.Stream
-    | FormUrlEncodedContent of Map<string, string>
-    | FileContent of string
-
-type ContentType = {
-    value: string
-    charset: System.Text.Encoding option
-}
-
-type ContentElement = {
-    contentData: ContentData
-    explicitContentType: ContentType option
-}
-
-type RequestContent =
+type BodyContent =
     | Empty
-    | Single of BodyContent
+    | Single of SinglepartContent
     | Multi of MultipartContent
 
-and BodyContent = {
+and SinglepartContent = {
     contentElement: ContentElement
     headers: Map<string, string>
 }
@@ -107,10 +90,26 @@ and MultipartElement = {
     fileName: string option
 }
 
+and ContentData =
+    | TextContent of string
+    | BinaryContent of byte array
+    | StreamContent of System.IO.Stream
+    | FormUrlEncodedContent of Map<string, string>
+    | FileContent of string
+
+and ContentType = {
+    value: string
+    charset: System.Text.Encoding option
+}
+
+and ContentElement = {
+    contentData: ContentData
+    explicitContentType: ContentType option
+}
+
 type Request = {
-    url: FsHttpUrl
     header: Header
-    content: RequestContent
+    content: BodyContent
     config: Config
 }
 
@@ -140,7 +139,6 @@ and IToMultipartContext =
 
 // TODO: Convert this to a class.
 and HeaderContext = {
-    url: FsHttpUrl
     header: Header
     config: Config
 } with
@@ -155,15 +153,13 @@ and HeaderContext = {
 
     interface IToRequest with
         member this.Transform() = {
-            url = this.url
             header = this.header
             content = Empty
             config = this.config
         }
 
     interface IToBodyContext with
         member this.Transform() = {
-            url = this.url
             header = this.header
             bodyContent = {
                 contentElement = {
@@ -177,7 +173,6 @@ and HeaderContext = {
 
     interface IToMultipartContext with
         member this.Transform() = {
-            url = this.url
             header = this.header
             config = this.config
             multipartContent = {
@@ -188,9 +183,8 @@ and HeaderContext = {
 
 // TODO: Convert this to a class.
 and BodyContext = {
-    url: FsHttpUrl
     header: Header
-    bodyContent: BodyContent
+    bodyContent: SinglepartContent
     config: Config
 } with
     interface IRequestContext<BodyContext> with
@@ -204,7 +198,6 @@ and BodyContext = {
 
     interface IToRequest with
         member this.Transform() = {
-            url = this.url
             header = this.header
             content = Single this.bodyContent
             config = this.config
@@ -215,7 +208,6 @@ and BodyContext = {
 
 // TODO: Convert this to a class.
 and MultipartContext = {
-    url: FsHttpUrl
     header: Header
     multipartContent: MultipartContent
     config: Config
@@ -231,7 +223,6 @@ and MultipartContext = {
 
     interface IToRequest with
         member this.Transform() = {
-            url = this.url
             header = this.header
             content = Multi this.multipartContent
             config = this.config

src/FsHttp/DomainExtensions.fs

@@ -5,7 +5,7 @@ open System
 open System.Net.Http.Headers
 open FsHttp
 
-type FsHttpUrl with
+type FsHttpTarget with
     member this.ToUriStringWithDefault(defaultValue) =
         let queryParamsString =
             this.additionalQueryParams

src/FsHttp/Dsl.CE.fs

@@ -427,6 +427,10 @@ type IRequestContext<'self> with
     member this.TimeoutInSeconds(context: IRequestContext<#IConfigure<ConfigTransformer, _>>, value) =
         Config.timeoutInSeconds value context.Self
 
+    [<CustomOperation("config_transformHeader")>]
+    member this.TransformHeader(context: IRequestContext<#IConfigure<ConfigTransformer, _>>, transformer) =
+        Config.transformHeader transformer context.Self
+
     [<CustomOperation("config_setHttpClientFactory")>]
     member this.SetHttpClientFactory(context: IRequestContext<#IConfigure<ConfigTransformer, _>>, httpClientFactory) =
         Config.setHttpClientFactory httpClientFactory context.Self

src/FsHttp/Dsl.fs

@@ -31,12 +31,12 @@ module Http =
         FsiInit.init ()
 
         {
-            url = {
-                address = address
-                additionalQueryParams = []
-            }
             header = {
-                method = method
+                target = {
+                    method = method
+                    address = address
+                    additionalQueryParams = []
+                }
                 headers = Map.empty
                 cookies = []
             }
@@ -98,7 +98,7 @@ module Header =
 
     /// Adds a set of query parameters to the URL
     let query (queryParams: (string * string) list) (context: HeaderContext) =
-        { context with url.additionalQueryParams = context.url.additionalQueryParams @ queryParams }
+        { context with header.target.additionalQueryParams = context.header.target.additionalQueryParams @ queryParams }
 
     /// Content-Types that are acceptable for the response
     let accept (contentType: string) (context: HeaderContext) = 
@@ -453,11 +453,17 @@ module Multipart =
 
 module Config =
     module With =
-        let ignoreCertIssues config = { config with certErrorStrategy = AlwaysAccept }
+        let ignoreCertIssues config =
+            { config with certErrorStrategy = AlwaysAccept }
+
+        let timeout value config =
+            { config with timeout = value }
 
-        let timeout value config = { config with timeout = value }
+        let timeoutInSeconds value config =
+            { config with timeout = Some(TimeSpan.FromSeconds value) }
 
-        let timeoutInSeconds value config = { config with timeout = Some(TimeSpan.FromSeconds value) }
+        let transformHeader transformer config = 
+            { config with headerTransformers = config.headerTransformers @ [ transformer ] }
 
         let setHttpClientFactory httpClientFactory config = { config with httpClientFactory = httpClientFactory }
 
@@ -500,6 +506,9 @@ module Config =
     let timeoutInSeconds value context = 
         context |> update (fun config -> config |> With.timeoutInSeconds value)
 
+    let transformHeader transformer context = 
+        context |> update (fun config -> config |> With.transformHeader transformer)
+
     let setHttpClientFactory httpClientFactory context =
         context |> update (fun config -> config |> With.setHttpClientFactory httpClientFactory)
 

src/FsHttp/Extensions.fs

@@ -439,6 +439,10 @@ type ConfigExtensions =
     static member TimeoutInSeconds(config: Domain.Config, value) =
         Config.With.timeoutInSeconds value config
 
+    [<Extension>]
+    static member TransformHeader(config: Domain.Config, transformer) =
+        Config.With.transformHeader transformer config
+
     [<Extension>]
     static member SetHttpClientFactory(config: Domain.Config, httpClientFactory) =
         Config.With.setHttpClientFactory httpClientFactory config

src/FsHttp/Request.fs

@@ -9,8 +9,8 @@ open FsHttp.Helper
 
 // TODO: Remove this
 let getAddressDefaults (request: Request) =
-    let uri = request.url.ToUriStringWithDefault("")
-    let method = request.header.method |> Option.defaultValue HttpMethod.Get
+    let uri = request.header.target.ToUriStringWithDefault("")
+    let method = request.header.target.method |> Option.defaultValue HttpMethod.Get
     uri, method
 
 let addressToString (request: Request) =
@@ -133,6 +133,12 @@ let toAsync cancellationTokenOverride (context: IToRequest) =
         let request, requestMessage = toRequestAndMessage context
         do Fsi.logfn $"Sending request {addressToString request} ..."
 
+        let request =
+            let mutable request = request
+            for headerTransformer in request.config.headerTransformers do
+                request <- { request with header = headerTransformer request.header }
+            request
+
         use finalRequestMessage =
             request.config.httpMessageTransformers
             |> List.fold (fun c n -> n c) requestMessage

src/Tests/Config.fs

@@ -145,3 +145,25 @@ let ``Cancellation token can be supplied by user`` () =
     |> should equal true
 
     wasCancelled |> should equal true
+
+
+let [<TestCase>] ``Header Transformer``() =
+    let url = "http://"
+    let urlSuffix1 = "suffix1"
+    let urlSuffix2 = "suffix2"
+
+    let request =
+        let transformWith suffix =
+            fun (header: Header) ->
+                let address = header.target.address.Value
+                { header with target.address = Some $"{address}{suffix}" }
+
+        http {
+            GET url
+            config_transformHeader (transformWith urlSuffix1)
+            config_transformHeader (transformWith urlSuffix2)
+        }
+
+    request.header.target.address
+    |> Option.defaultValue ""
+    |> should equal $"{url}{urlSuffix1}{urlSuffix2}"

src/Tests/Misc.fs

@@ -127,6 +127,7 @@ let ``Response Decompression`` () =
         sr.ReadToEnd()
     |> should equal responseText
 
+
 //let [<TestCase>] ``Auto Redirects``() =
 //    http {
 //        GET (url @"")