Tidy infra

src/Equinox.Core/Infrastructure.fs

@@ -3,7 +3,6 @@
 module internal Equinox.Core.Infrastructure
 
 open FSharp.Control
-open System
 open System.Diagnostics
 open System.Threading.Tasks
 

tests/Equinox.CosmosStore.Integration/Equinox.CosmosStore.Integration.fsproj

@@ -26,7 +26,6 @@
 
   <ItemGroup>
     <PackageReference Include="Microsoft.Azure.Cosmos" Version="3.17.0" />
-<!--    <PackageReference Include="Microsoft.Azure.Cosmos.Direct" Version="3.17.1" />-->
     <PackageReference Include="FsCheck.xUnit" Version="2.14.0" />
     <PackageReference Include="JsonDiffPatch.Net" Version="2.1.0" />
     <PackageReference Include="Microsoft.NET.Test.Sdk" Version="16.3.0" />

tools/Equinox.Tool/Equinox.Tool.fsproj

@@ -21,7 +21,6 @@
 
   <ItemGroup>
     <Compile Include="Infrastructure\Infrastructure.fs" />
-    <Compile Include="Infrastructure\HttpHelpers.fs" />
     <Compile Include="StoreClient.fs" />
     <Compile Include="TodoClient.fs" />
     <Compile Include="Tests.fs" />
@@ -40,7 +39,6 @@
     <PackageReference Include="MinVer" Version="2.5.0" PrivateAssets="All" />
 
     <PackageReference Include="Microsoft.Azure.Cosmos" Version="3.17.0" />
-<!--    <PackageReference Include="Microsoft.Azure.Cosmos.Direct" Version="3.17.1" />-->
 
 <!--    NOTE cannot be 4.7.0 as Async.Sequential is broken-->
     <PackageReference Include="FSharp.Core" Version="4.7.1" />

tools/Equinox.Tool/Infrastructure/Infrastructure.fs

@@ -1,14 +1,14 @@
 [<AutoOpen>]
-module Equinox.Tool.Infrastructure.Prelude
+module internal Equinox.Tool.Infrastructure.Prelude
 
+open Equinox.Tools.TestHarness.HttpHelpers
 open System
 open System.Diagnostics
 open System.Text
-open System.Threading
 
 type Exception with
     // https://github.com/fsharp/fslang-suggestions/issues/660
-    member this.Reraise () =
+    member this.Reraise() =
         (System.Runtime.ExceptionServices.ExceptionDispatchInfo.Capture this).Throw ()
         Unchecked.defaultof<_>
 
@@ -17,7 +17,7 @@ type Async with
     ///     Raises an exception using Async's continuation mechanism directly.
     /// </summary>
     /// <param name="exn">Exception to be raised.</param>
-    static member Raise (exn : #exn) = Async.FromContinuations(fun (_,ec,_) -> ec exn)
+    static member Raise(exn : #exn) = Async.FromContinuations(fun (_,ec,_) -> ec exn)
 
     /// <summary>
     ///     Gets the result of given task so that in the event of exception
@@ -33,7 +33,7 @@ type Async with
                     let e = t.Exception
                     if e.InnerExceptions.Count = 1 then ec e.InnerExceptions.[0]
                     else ec e
-                elif t.IsCanceled then ec(new System.Threading.Tasks.TaskCanceledException())
+                elif t.IsCanceled then ec(System.Threading.Tasks.TaskCanceledException())
                 else sc t.Result)
             |> ignore)
     [<DebuggerStepThrough>]
@@ -49,40 +49,12 @@ type Async with
                 else
                     sc ())
             |> ignore)
-    /// Creates an async computation which runs the provided sequence of computations and completes
-    /// when all computations in the sequence complete. Up to parallelism computations will
-    /// be in-flight at any given point in time. Error or cancellation of any computation in
-    /// the sequence causes the resulting computation to error or cancel, respectively.
-    /// Like Async.Parallel but with support for throttling.
-    /// Note that an array is allocated to contain the results of all computations.
-    static member ParallelThrottled (parallelism:int) (tasks:seq<Async<'T>>) : Async<'T[]> = async {
-        if parallelism < 1 then invalidArg "parallelism" "Must be positive number."
-        use semaphore = new SemaphoreSlim(parallelism)
-        let throttledWorker (task:Async<'T>) = async {
-            let! ct = Async.CancellationToken
-            do! semaphore.WaitAsync ct |> Async.AwaitTaskCorrect
-            try return! task
-            finally ignore(semaphore.Release())
-        }
-
-        return! tasks |> Seq.map throttledWorker |> Async.Parallel
-    }
-
-type StringBuilder with
-    member sb.Appendf fmt = Printf.ksprintf (ignore << sb.Append) fmt
-    member sb.Appendfn fmt = Printf.ksprintf (ignore << sb.AppendLine) fmt
-
-    static member inline Build(builder : StringBuilder -> unit) =
-        let instance = StringBuilder() // TOCONSIDER PooledStringBuilder.GetInstance()
-        builder instance
-        instance.ToString()
 
 [<AutoOpen>]
 module HttpHelpers =
 
     open System.Net
     open System.Net.Http
-    open System.Runtime.Serialization
 
     /// Operations on System.Net.HttpRequestMessage
     module HttpReq =
@@ -138,25 +110,12 @@ module HttpHelpers =
             request.Headers.Add(name, value)
             request
 
-    type HttpContent with
-        member c.ReadAsString() = async {
-            match c with
-            | null -> return null
-            | c -> return! c.ReadAsStringAsync() |> Async.AwaitTaskCorrect
-        }
-
-        // only intended for logging under control of InvalidHttpResponseException, hence the esoteric name
-        member internal c.ReadAsStringDiapered() = async {
-            try return! c.ReadAsString()
-            with :? ObjectDisposedException -> return "<HttpContent:ObjectDisposedException>"
-        }
-
     type HttpClient with
         /// <summary>
         ///     Drop-in replacement for HttpClient.SendAsync which addresses known timeout issues
         /// </summary>
         /// <param name="msg">HttpRequestMessage to be submitted.</param>
-        member client.Send(msg : HttpRequestMessage) = async {
+        member client.SendAsync2(msg : HttpRequestMessage) = async {
             let! ct = Async.CancellationToken
             try return! client.SendAsync(msg, ct) |> Async.AwaitTaskCorrect
             // address https://github.com/dotnet/corefx/issues/20296
@@ -169,67 +128,6 @@ module HttpHelpers =
                 return! Async.Raise(TimeoutException message)
         }
 
-    /// Exception indicating an unexpected response received by an Http Client
-    type InvalidHttpResponseException =
-        inherit Exception
-
-        // TODO: include headers
-        val private userMessage : string
-        val private requestMethod : string
-        val RequestUri : Uri
-        val RequestBody : string
-        val StatusCode : HttpStatusCode
-        val ReasonPhrase : string
-        val ResponseBody : string
-
-        member __.RequestMethod = new HttpMethod(__.requestMethod)
-
-        private new (userMessage : string, requestMethod : HttpMethod, requestUri : Uri, requestBody : string,
-                       statusCode : HttpStatusCode, reasonPhrase : string, responseBody : string,
-                       ?innerException : exn) =
-            {
-                inherit Exception(message = null, innerException = defaultArg innerException null) ; userMessage = userMessage ;
-                requestMethod = string requestMethod ; RequestUri = requestUri ; RequestBody = requestBody ;
-                StatusCode = statusCode ; ReasonPhrase = reasonPhrase ; ResponseBody = responseBody
-            }
-
-        override e.Message =
-            StringBuilder.Build(fun sb ->
-                sb.Appendfn "%s %O RequestUri=%O HttpStatusCode=%O" e.userMessage e.RequestMethod e.RequestUri e.StatusCode
-                let getBodyString str = if String.IsNullOrWhiteSpace str then "<null>" else str
-                sb.Appendfn "RequestBody=%s" (getBodyString e.RequestBody)
-                sb.Appendfn "ResponseBody=%s" (getBodyString e.ResponseBody))
-
-        interface ISerializable with
-            member e.GetObjectData(si : SerializationInfo, sc : StreamingContext) =
-                let add name (value:obj) = si.AddValue(name, value)
-                base.GetObjectData(si, sc) ; add "userMessage" e.userMessage ;
-                add "requestUri" e.RequestUri ; add "requestMethod" e.requestMethod ; add "requestBody" e.RequestBody
-                add "statusCode" e.StatusCode ; add "reasonPhrase" e.ReasonPhrase ; add "responseBody" e.ResponseBody
-
-        new (si : SerializationInfo, sc : StreamingContext) =
-            let get name = si.GetValue(name, typeof<'a>) :?> 'a
-            {
-                inherit Exception(si, sc) ; userMessage = get "userMessage" ;
-                RequestUri = get "requestUri" ; requestMethod = get "requestMethod" ; RequestBody = get "requestBody" ;
-                StatusCode = get "statusCode" ; ReasonPhrase = get "reasonPhrase" ; ResponseBody = get "responseBody"
-            }
-
-        static member Create(userMessage : string, response : HttpResponseMessage, ?innerException : exn) = async {
-            let request = response.RequestMessage
-            let! responseBodyC = response.Content.ReadAsStringDiapered() |> Async.StartChild
-            let! requestBody = request.Content.ReadAsStringDiapered()
-            let! responseBody = responseBodyC
-            return
-                new InvalidHttpResponseException(
-                    userMessage, request.Method, request.RequestUri, requestBody,
-                    response.StatusCode, response.ReasonPhrase, responseBody,
-                    ?innerException = innerException)
-        }
-
-        static member Create(response : HttpResponseMessage, ?innerException : exn) =
-            InvalidHttpResponseException.Create("HTTP request yielded unexpected response.", response, ?innerException = innerException)
-
     type HttpResponseMessage with
 
         /// Raises an <c>InvalidHttpResponseException</c> if the response status code does not match expected value.
@@ -264,4 +162,12 @@ module HttpHelpers =
 
         /// Deserialize body using default Json.Net profile - throw with content details if StatusCode is not OK or decoding fails
         let deserializeOkJsonNet<'t> =
-            deserializeExpectedJsonNet<'t> HttpStatusCode.OK
+            deserializeExpectedJsonNet<'t> HttpStatusCode.OK
+
+type StringBuilder with
+    member sb.Appendf fmt = Printf.ksprintf (ignore << sb.Append) fmt
+
+    static member inline Build(builder : StringBuilder -> unit) =
+        let instance = StringBuilder() // TOCONSIDER PooledStringBuilder.GetInstance()
+        builder instance
+        instance.ToString()

tools/Equinox.Tool/StoreClient.fs

@@ -8,21 +8,21 @@ open System.Net.Http
 
 type Session(client: HttpClient, clientId: ClientId) =
 
-    member __.Send(req : HttpRequestMessage) : Async<HttpResponseMessage> =
+    member _.Send(req : HttpRequestMessage) : Async<HttpResponseMessage> =
         let req = req |> HttpReq.withHeader "COMPLETELY_INSECURE_CLIENT_ID" (ClientId.toString clientId)
-        client.Send(req)
+        client.SendAsync2(req)
 
-type Favorited = { date: System.DateTimeOffset; skuId: SkuId }
+type Favorited = { date: DateTimeOffset; skuId: SkuId }
 
 type FavoritesClient(session: Session) =
 
-    member __.Favorite(skus: SkuId[]) = async {
+    member _.Favorite(skus: SkuId[]) = async {
         let request = HttpReq.post () |> HttpReq.withPath "api/favorites" |> HttpReq.withJsonNet skus
         let! response = session.Send request
         return! response.EnsureStatusCode(HttpStatusCode.NoContent)
     }
 
-    member __.List = async {
+    member _.List = async {
         let request = HttpReq.get () |> HttpReq.withPath "api/favorites"
         let! response = session.Send request
         return! response |> HttpRes.deserializeOkJsonNet<Favorited[]>
@@ -33,8 +33,8 @@ type Saved = { skuId : SkuId; dateSaved : DateTimeOffset }
 type SavesClient(session: Session) =
 
     // this (returning a bool indicating whether it got saved) is fine for now
-    // IRL we don't want to be leaning on the fact we get a 400 when we exceed the max imems limit as a core API design element
-    member __.Save(skus: SkuId[]) : Async<bool> = async {
+    // IRL we don't want to be leaning on the fact we get a 400 when we exceed the max items limit as a core API design element
+    member _.Save(skus: SkuId[]) : Async<bool> = async {
         let request = HttpReq.post () |> HttpReq.withPath "api/saves" |> HttpReq.withJsonNet skus
         let! response = session.Send request
         if response.StatusCode = HttpStatusCode.BadRequest then
@@ -44,13 +44,13 @@ type SavesClient(session: Session) =
             return true
     }
 
-    member __.Remove(skus: SkuId[]) : Async<unit> = async {
+    member _.Remove(skus: SkuId[]) : Async<unit> = async {
         let request = HttpReq.delete () |> HttpReq.withPath "api/saves" |> HttpReq.withJsonNet skus
         let! response = session.Send request
         return! response.EnsureStatusCode(HttpStatusCode.NoContent)
     }
 
-    member __.List = async {
+    member _.List = async {
         let request = HttpReq.get () |> HttpReq.withPath "api/saves"
         let! response = session.Send request
         return! response |> HttpRes.deserializeOkJsonNet<Saved[]>
@@ -59,4 +59,4 @@ type SavesClient(session: Session) =
 type Session with
 
     member session.Favorites = FavoritesClient session
-    member session.Saves = SavesClient session
+    member session.Saves = SavesClient session

tools/Equinox.Tool/TodoClient.fs

@@ -10,9 +10,9 @@ type Todo = { id: int; url: string; order: int; title: string; completed: bool }
 
 type Session(client: HttpClient, clientId: ClientId) =
 
-    member __.Send(req : HttpRequestMessage) : Async<HttpResponseMessage> =
+    member _.Send(req : HttpRequestMessage) : Async<HttpResponseMessage> =
         let req = req |> HttpReq.withHeader "COMPLETELY_INSECURE_CLIENT_ID" (ClientId.toString clientId)
-        client.Send(req)
+        client.SendAsync2(req)
 
 type TodosClient(session: Session) =
 
@@ -37,7 +37,7 @@ type TodosClient(session: Session) =
     }
 
     member __.Clear() : Async<unit> = async {
-        let request = HttpReq.delete () |> HttpReq.withPath basePath 
+        let request = HttpReq.delete () |> HttpReq.withPath basePath
         let! response = session.Send request
         return! response.EnsureStatusCode(HttpStatusCode.NoContent)
     }

tools/Equinox.Tools.TestHarness/Equinox.Tools.TestHarness.fsproj

@@ -21,7 +21,8 @@
     <PackageReference Include="MinVer" Version="2.5.0" PrivateAssets="All" />
     <PackageReference Include="Microsoft.SourceLink.GitHub" Version="1.0.0" PrivateAssets="All" />
 
-    <PackageReference Include="FSharp.Core" Version="4.3.4" />
+    <!-- 4.7.0 has broken Async.Sequential, Async.Parallel with degree of parallelism parameter -->
+    <PackageReference Include="FSharp.Core" Version="4.7.1" />
 
     <PackageReference Include="MathNet.Numerics" Version="4.7.0" />
     <PackageReference Include="Serilog" Version="2.7.1" />