From dd3f9131a3f2c5ae5345e5765b9b08c92f973469 Mon Sep 17 00:00:00 2001 From: Andrii Kurdiumov Date: Sat, 15 Jul 2023 23:21:32 +0600 Subject: [PATCH 1/9] Add support for plain control types Closes: #1193 --- src/FSharp.Data.Http/Http.fs | 41 +++++++++++++++++++++++++++--------- 1 file changed, 31 insertions(+), 10 deletions(-) diff --git a/src/FSharp.Data.Http/Http.fs b/src/FSharp.Data.Http/Http.fs index 95411fef6..78b1a6dfc 100644 --- a/src/FSharp.Data.Http/Http.fs +++ b/src/FSharp.Data.Http/Http.fs @@ -636,6 +636,11 @@ module HttpStatusCodes = type MultipartItem = MultipartItem of formField: string * filename: string * content: Stream +type MultipartFileItem = MultipartFileItem of formField: string * filename: string option * contentType: string option * content: Stream + +type MultipartFormDataItem = + | FileValue of MultipartFileItem + | FormValue of string * string /// The body to send in an HTTP request type HttpRequestBody = @@ -649,6 +654,9 @@ type HttpRequestBody = /// A sequence of formParamName * fileName * fileContent groups | Multipart of boundary: string * parts: seq + /// A sequence of formParamName * fileName * fileContent groups + | MultipartFormData of boundary: string * parts: seq + /// The response body returned by an HTTP request type HttpResponseBody = | Text of string @@ -1521,7 +1529,7 @@ module internal HttpHelpers = /// c) write newline /// d) write section data /// 3) write trailing boundary - let writeMultipart (boundary: string) (parts: seq) (e: Encoding) = + let writeMultipart (boundary: string) (parts: seq) (e: Encoding) = let newlineStream () = new MemoryStream(e.GetBytes "\r\n") :> Stream @@ -1545,17 +1553,20 @@ module internal HttpHelpers = let segments = parts - |> Seq.map (fun (MultipartItem (formField, fileName, contentStream)) -> - let fileExt = Path.GetExtension fileName - let contentType = defaultArg (MimeTypes.tryFind fileExt) "application/octet-stream" + |> Seq.map (fun (MultipartFileItem(formField, fileName, contentType, contentStream)) -> let printHeader (header, value) = sprintf "%s: %s" header value + let sharedHeaders = [ + prefixedBoundary + HttpRequestHeaders.ContentDisposition("form-data", Some formField, fileName) + |> printHeader ] + let headers = match contentType with + | Some(contentType) -> + sharedHeaders + |> Seq.append [ HttpRequestHeaders.ContentType contentType |> printHeader ] + | None -> sharedHeaders let headerpart = - [ prefixedBoundary - HttpRequestHeaders.ContentDisposition("form-data", Some formField, Some fileName) - |> printHeader - HttpRequestHeaders.ContentType contentType - |> printHeader ] + headers |> String.concat "\r\n" let headerStream = @@ -2079,7 +2090,17 @@ type Http private () = |> e.GetBytes HttpContentTypes.FormValues, (fun e -> new MemoryStream(bytes e) :> _) - | Multipart (boundary, parts) -> HttpContentTypes.Multipart(boundary), writeMultipart boundary parts + | Multipart (boundary, parts) -> + let fileParts = parts |> Seq.map (fun (MultipartItem(formField, fileName, stream)) -> + let fileExt = Path.GetExtension fileName + let contentType = defaultArg (MimeTypes.tryFind fileExt) "application/octet-stream" + MultipartFileItem(formField, Some fileName, Some contentType, stream)) + HttpContentTypes.Multipart(boundary), writeMultipart boundary fileParts + | MultipartFormData (boundary, parts) -> + let fileParts = parts |> Seq.map (fun p -> match p with + | FormValue(formField, value) -> MultipartFileItem(formField, None, None, new MemoryStream(Encoding.UTF8.GetBytes(value))) + | FileValue(item) -> item) + HttpContentTypes.Multipart(boundary), writeMultipart boundary fileParts // Set default content type if it is not specified by the user let encoding = From 0dc72651acd5a0bbc18975b4343cedf277e31458 Mon Sep 17 00:00:00 2001 From: Andrii Kurdiumov Date: Tue, 18 Jul 2023 22:09:44 +0600 Subject: [PATCH 2/9] Format code --- src/FSharp.Data.Http/Http.fs | 62 +++++++++++++++++++++++------------- 1 file changed, 40 insertions(+), 22 deletions(-) diff --git a/src/FSharp.Data.Http/Http.fs b/src/FSharp.Data.Http/Http.fs index 78b1a6dfc..9d5bf40ed 100644 --- a/src/FSharp.Data.Http/Http.fs +++ b/src/FSharp.Data.Http/Http.fs @@ -636,7 +636,9 @@ module HttpStatusCodes = type MultipartItem = MultipartItem of formField: string * filename: string * content: Stream -type MultipartFileItem = MultipartFileItem of formField: string * filename: string option * contentType: string option * content: Stream + +type MultipartFileItem = + | MultipartFileItem of formField: string * filename: string option * contentType: string option * content: Stream type MultipartFormDataItem = | FileValue of MultipartFileItem @@ -655,7 +657,7 @@ type HttpRequestBody = | Multipart of boundary: string * parts: seq /// A sequence of formParamName * fileName * fileContent groups - | MultipartFormData of boundary: string * parts: seq + | MultipartFormData of boundary: string * parts: seq /// The response body returned by an HTTP request type HttpResponseBody = @@ -1553,21 +1555,24 @@ module internal HttpHelpers = let segments = parts - |> Seq.map (fun (MultipartFileItem(formField, fileName, contentType, contentStream)) -> + |> Seq.map (fun (MultipartFileItem (formField, fileName, contentType, contentStream)) -> let printHeader (header, value) = sprintf "%s: %s" header value - let sharedHeaders = [ - prefixedBoundary - HttpRequestHeaders.ContentDisposition("form-data", Some formField, fileName) - |> printHeader ] - let headers = match contentType with - | Some(contentType) -> - sharedHeaders - |> Seq.append [ HttpRequestHeaders.ContentType contentType |> printHeader ] - | None -> sharedHeaders - let headerpart = - headers - |> String.concat "\r\n" + let sharedHeaders = + [ prefixedBoundary + HttpRequestHeaders.ContentDisposition("form-data", Some formField, fileName) + |> printHeader ] + + let headers = + match contentType with + | Some (contentType) -> + sharedHeaders + |> Seq.append + [ HttpRequestHeaders.ContentType contentType + |> printHeader ] + | None -> sharedHeaders + + let headerpart = headers |> String.concat "\r\n" let headerStream = let bytes = e.GetBytes headerpart @@ -2091,15 +2096,28 @@ type Http private () = HttpContentTypes.FormValues, (fun e -> new MemoryStream(bytes e) :> _) | Multipart (boundary, parts) -> - let fileParts = parts |> Seq.map (fun (MultipartItem(formField, fileName, stream)) -> - let fileExt = Path.GetExtension fileName - let contentType = defaultArg (MimeTypes.tryFind fileExt) "application/octet-stream" - MultipartFileItem(formField, Some fileName, Some contentType, stream)) + let fileParts = + parts + |> Seq.map (fun (MultipartItem (formField, fileName, stream)) -> + let fileExt = Path.GetExtension fileName + let contentType = defaultArg (MimeTypes.tryFind fileExt) "application/octet-stream" + MultipartFileItem(formField, Some fileName, Some contentType, stream)) + HttpContentTypes.Multipart(boundary), writeMultipart boundary fileParts | MultipartFormData (boundary, parts) -> - let fileParts = parts |> Seq.map (fun p -> match p with - | FormValue(formField, value) -> MultipartFileItem(formField, None, None, new MemoryStream(Encoding.UTF8.GetBytes(value))) - | FileValue(item) -> item) + let fileParts = + parts + |> Seq.map (fun p -> + match p with + | FormValue (formField, value) -> + MultipartFileItem( + formField, + None, + None, + new MemoryStream(Encoding.UTF8.GetBytes(value)) + ) + | FileValue (item) -> item) + HttpContentTypes.Multipart(boundary), writeMultipart boundary fileParts // Set default content type if it is not specified by the user From 9b62cd78760683f007e06d6d42ae13c3914d4dc8 Mon Sep 17 00:00:00 2001 From: Andrii Kurdiumov Date: Tue, 18 Jul 2023 22:46:59 +0600 Subject: [PATCH 3/9] Refactor to fix tests --- src/FSharp.Data.Http/Http.fs | 24 +++++++++++++----------- 1 file changed, 13 insertions(+), 11 deletions(-) diff --git a/src/FSharp.Data.Http/Http.fs b/src/FSharp.Data.Http/Http.fs index 9d5bf40ed..e0ec1b83e 100644 --- a/src/FSharp.Data.Http/Http.fs +++ b/src/FSharp.Data.Http/Http.fs @@ -1531,7 +1531,7 @@ module internal HttpHelpers = /// c) write newline /// d) write section data /// 3) write trailing boundary - let writeMultipart (boundary: string) (parts: seq) (e: Encoding) = + let writeMultipartFileItem (boundary: string) (parts: seq) (e: Encoding) = let newlineStream () = new MemoryStream(e.GetBytes "\r\n") :> Stream @@ -1599,6 +1599,16 @@ module internal HttpHelpers = let wholePayloadLength = wholePayload |> trySumLength new CombinedStream(wholePayloadLength, wholePayload) :> Stream + let writeMultipart (boundary: string) (parts: seq) (e: Encoding) = + let fileParts = + parts + |> Seq.map (fun (MultipartItem (formField, fileName, stream)) -> + let fileExt = Path.GetExtension fileName + let contentType = defaultArg (MimeTypes.tryFind fileExt) "application/octet-stream" + MultipartFileItem(formField, Some fileName, Some contentType, stream)) + + writeMultipartFileItem boundary fileParts e + let asyncCopy (source: Stream) (dest: Stream) = async { do! @@ -2095,15 +2105,7 @@ type Http private () = |> e.GetBytes HttpContentTypes.FormValues, (fun e -> new MemoryStream(bytes e) :> _) - | Multipart (boundary, parts) -> - let fileParts = - parts - |> Seq.map (fun (MultipartItem (formField, fileName, stream)) -> - let fileExt = Path.GetExtension fileName - let contentType = defaultArg (MimeTypes.tryFind fileExt) "application/octet-stream" - MultipartFileItem(formField, Some fileName, Some contentType, stream)) - - HttpContentTypes.Multipart(boundary), writeMultipart boundary fileParts + | Multipart (boundary, parts) -> HttpContentTypes.Multipart(boundary), writeMultipart boundary parts | MultipartFormData (boundary, parts) -> let fileParts = parts @@ -2118,7 +2120,7 @@ type Http private () = ) | FileValue (item) -> item) - HttpContentTypes.Multipart(boundary), writeMultipart boundary fileParts + HttpContentTypes.Multipart(boundary), writeMultipartFileItem boundary fileParts // Set default content type if it is not specified by the user let encoding = From 69aeb5e5c31bb7063196ec8c0dec38c2d941f93b Mon Sep 17 00:00:00 2001 From: Andrii Kurdiumov Date: Wed, 19 Jul 2023 22:10:29 +0600 Subject: [PATCH 4/9] Experimental debug --- .github/workflows/pull-requests.yml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/.github/workflows/pull-requests.yml b/.github/workflows/pull-requests.yml index 22e3caf4d..0b0822dcc 100644 --- a/.github/workflows/pull-requests.yml +++ b/.github/workflows/pull-requests.yml @@ -20,7 +20,9 @@ jobs: - name: Restore packages run: dotnet paket restore - name: Build and test (Release) - run: dotnet fake build -t All + run: + set FAKE_DETAILED_ERRORS=true + dotnet fake build -t All - name: Build (Debug) run: dotnet build -c Debug -v n From 673aaac77eeb2d5a84c13ee8a0481783976ce7c6 Mon Sep 17 00:00:00 2001 From: Andrii Kurdiumov Date: Wed, 19 Jul 2023 23:07:18 +0600 Subject: [PATCH 5/9] One more debug build --- .github/workflows/pull-requests.yml | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/.github/workflows/pull-requests.yml b/.github/workflows/pull-requests.yml index 0b0822dcc..db83fa853 100644 --- a/.github/workflows/pull-requests.yml +++ b/.github/workflows/pull-requests.yml @@ -5,6 +5,9 @@ on: branches: - main +env: + FAKE_DETAILED_ERRORS: true + jobs: build-windows: @@ -20,9 +23,7 @@ jobs: - name: Restore packages run: dotnet paket restore - name: Build and test (Release) - run: - set FAKE_DETAILED_ERRORS=true - dotnet fake build -t All + run: dotnet fake build -t All - name: Build (Debug) run: dotnet build -c Debug -v n From ccc2ad7be2c4ff26c27d6a58b87d0421a127ee91 Mon Sep 17 00:00:00 2001 From: Andrii Kurdiumov Date: Wed, 19 Jul 2023 23:08:09 +0600 Subject: [PATCH 6/9] And one more --- .github/workflows/pull-requests.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/pull-requests.yml b/.github/workflows/pull-requests.yml index db83fa853..f626d4bd3 100644 --- a/.github/workflows/pull-requests.yml +++ b/.github/workflows/pull-requests.yml @@ -5,8 +5,6 @@ on: branches: - main -env: - FAKE_DETAILED_ERRORS: true jobs: build-windows: @@ -23,6 +21,8 @@ jobs: - name: Restore packages run: dotnet paket restore - name: Build and test (Release) + env: + FAKE_DETAILED_ERRORS: true run: dotnet fake build -t All - name: Build (Debug) run: dotnet build -c Debug -v n From 69d641c7a18021f9f684613b9123e6ec04c2a006 Mon Sep 17 00:00:00 2001 From: Andrii Kurdiumov Date: Fri, 21 Jul 2023 16:29:54 +0600 Subject: [PATCH 7/9] Fix test --- src/FSharp.Data.Http/Http.fs | 17 +++++++---------- 1 file changed, 7 insertions(+), 10 deletions(-) diff --git a/src/FSharp.Data.Http/Http.fs b/src/FSharp.Data.Http/Http.fs index e0ec1b83e..0ad20c1e9 100644 --- a/src/FSharp.Data.Http/Http.fs +++ b/src/FSharp.Data.Http/Http.fs @@ -1558,19 +1558,16 @@ module internal HttpHelpers = |> Seq.map (fun (MultipartFileItem (formField, fileName, contentType, contentStream)) -> let printHeader (header, value) = sprintf "%s: %s" header value - let sharedHeaders = - [ prefixedBoundary - HttpRequestHeaders.ContentDisposition("form-data", Some formField, fileName) - |> printHeader ] - let headers = match contentType with | Some (contentType) -> - sharedHeaders - |> Seq.append - [ HttpRequestHeaders.ContentType contentType - |> printHeader ] - | None -> sharedHeaders + [ prefixedBoundary + HttpRequestHeaders.ContentDisposition("form-data", Some formField, fileName) |> printHeader + HttpRequestHeaders.ContentType contentType |> printHeader ] + | None -> + [ prefixedBoundary + HttpRequestHeaders.ContentDisposition("form-data", Some formField, fileName) + |> printHeader ] let headerpart = headers |> String.concat "\r\n" From 89d8f05f20f5a8295c84b67bc2c06488aab789d1 Mon Sep 17 00:00:00 2001 From: Andrii Kurdiumov Date: Sun, 23 Jul 2023 21:12:47 +0600 Subject: [PATCH 8/9] Fix format --- src/FSharp.Data.Http/Http.fs | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/FSharp.Data.Http/Http.fs b/src/FSharp.Data.Http/Http.fs index 0ad20c1e9..039eec399 100644 --- a/src/FSharp.Data.Http/Http.fs +++ b/src/FSharp.Data.Http/Http.fs @@ -1562,8 +1562,10 @@ module internal HttpHelpers = match contentType with | Some (contentType) -> [ prefixedBoundary - HttpRequestHeaders.ContentDisposition("form-data", Some formField, fileName) |> printHeader - HttpRequestHeaders.ContentType contentType |> printHeader ] + HttpRequestHeaders.ContentDisposition("form-data", Some formField, fileName) + |> printHeader + HttpRequestHeaders.ContentType contentType + |> printHeader ] | None -> [ prefixedBoundary HttpRequestHeaders.ContentDisposition("form-data", Some formField, fileName) From 649b0e0522ca7a4a5dffa565b051ac3c29584465 Mon Sep 17 00:00:00 2001 From: Andrii Kurdiumov Date: Sun, 23 Jul 2023 21:15:24 +0600 Subject: [PATCH 9/9] Add Foramt and CheckFormat targets to the help --- build.fsx | 2 ++ 1 file changed, 2 insertions(+) diff --git a/build.fsx b/build.fsx index fec931a5d..e79e19cfc 100644 --- a/build.fsx +++ b/build.fsx @@ -184,6 +184,8 @@ Target.create "Help" (fun _ -> printfn "" printfn " Other targets:" printfn " * CleanInternetCaches" + printfn " * Format" + printfn " * CheckFormat" printfn "") let sourceFiles =