11namespace App
22
3+ open System
4+ open System.Collections .Generic
5+ open System.Threading .Tasks
6+ open Oxpecker
7+
38[<AutoOpen>]
49module Common =
5- open System
610
711 [<CLIMutable>]
812 type Fortune =
@@ -14,8 +18,10 @@ module Common =
1418 [<Literal>]
1519 let ConnectionString = " Server=tfb-database;Database=hello_world;User Id=benchmarkdbuser;Password=benchmarkdbpass;SSL Mode=Disable;Maximum Pool Size=1024;NoResetOnClose=true;Enlist=false;Max Auto Prepare=4;Multiplexing=true;Write Coalescing Buffer Threshold Bytes=1000"
1620
17- let fortuneComparer a b =
18- String.CompareOrdinal( a.message, b.message)
21+ let FortuneComparer = {
22+ new IComparer< Fortune> with
23+ member self.Compare ( a , b ) = String.CompareOrdinal( a.message, b.message)
24+ }
1925
2026[<RequireQualifiedAccess>]
2127module HtmlViews =
@@ -50,63 +56,173 @@ module HtmlViews =
5056
5157[<RequireQualifiedAccess>]
5258module HttpHandlers =
53- open Oxpecker
5459 open Dapper
5560 open Npgsql
61+ open System.Text
62+ open Microsoft.AspNetCore .Http
5663
5764 let private extra =
5865 {
5966 id = 0
6067 message = " Additional fortune added at request time."
6168 }
6269
70+ let private renderFortunes ( ctx : HttpContext ) dbFortunes =
71+ let augmentedData = [|
72+ yield ! dbFortunes
73+ extra
74+ |]
75+ Array.Sort( augmentedData, FortuneComparer)
76+ augmentedData |> HtmlViews.fortunes |> ctx.WriteHtmlView
77+
6378 let private fortunes : EndpointHandler =
6479 fun ctx ->
6580 task {
6681 use conn = new NpgsqlConnection( ConnectionString)
67- let! data = conn.QueryAsync< Fortune>( " SELECT id, message FROM fortune" )
68- let augmentedData = [|
69- yield ! data
70- extra
71- |]
72- augmentedData |> Array.sortInPlaceWith fortuneComparer
73- let view = HtmlViews.fortunes augmentedData
74- return ! ctx.WriteHtmlView view
82+ let! dbFortunes = conn.QueryAsync< Fortune>( " SELECT id, message FROM fortune" )
83+ return ! renderFortunes ctx dbFortunes
84+ }
85+
86+ [<Struct>]
87+ [<CLIMutable>]
88+ type World =
89+ {
90+ id: int
91+ randomnumber: int
92+ }
93+
94+ let private readSingleRow ( conn : NpgsqlConnection ) =
95+ conn.QueryFirstOrDefaultAsync< World>(
96+ " SELECT id, randomnumber FROM world WHERE id = @Id" ,
97+ {| Id = Random.Shared.Next( 1 , 10001 ) |}
98+ )
99+
100+ let private parseQueries ( ctx : HttpContext ) =
101+ match ctx.TryGetRouteValue< string>( " count" ) with
102+ | Some q ->
103+ match Int32.TryParse q with
104+ | true , q when q > 1 -> if q < 500 then q else 500
105+ | _, _ -> 1
106+ | _ -> 1
107+
108+ let private singleQuery : EndpointHandler =
109+ fun ctx ->
110+ task {
111+ use conn = new NpgsqlConnection( ConnectionString)
112+ let! result = readSingleRow conn
113+ return ! ctx.WriteJsonChunked result
75114 }
76115
77- let endpoints : Endpoint [] =
116+ let private multipleQueries : EndpointHandler =
117+ fun ctx ->
118+ let count = parseQueries ctx
119+ let results = Array.zeroCreate< World> count
120+ task {
121+ use conn = new NpgsqlConnection( ConnectionString)
122+ do ! conn.OpenAsync()
123+ for i in 0 .. results.Length-1 do
124+ let! result = readSingleRow conn
125+ results[ i] <- result
126+ return ! ctx.WriteJsonChunked results
127+ }
128+
129+ let private maxBatch = 500
130+ let mutable private queries = Array.zeroCreate ( maxBatch + 1 )
131+
132+ let private batchUpdateString batchSize =
133+ match queries[ batchSize] with
134+ | null ->
135+ let lastIndex = batchSize - 1
136+ let sb = StringBuilder()
137+ sb.Append( " UPDATE world SET randomNumber = temp.randomNumber FROM (VALUES " ) |> ignore
138+ for i in 0 .. lastIndex-1 do
139+ sb.AppendFormat( " (@Id_{0}, @Rn_{0}), " , i) |> ignore
140+ sb.AppendFormat( " (@Id_{0}, @Rn_{0}) ORDER BY 1) AS temp(id, randomNumber) WHERE temp.id = world.id" , lastIndex) |> ignore
141+ let result = sb.ToString()
142+ queries[ batchSize] <- result
143+ result
144+ | q -> q
145+
146+ let private multipleUpdates : EndpointHandler =
147+ fun ctx ->
148+ let count = parseQueries ctx
149+ let results = Array.zeroCreate< World> count
150+ task {
151+ use conn = new NpgsqlConnection( ConnectionString)
152+ do ! conn.OpenAsync()
153+ for i in 0 .. results.Length-1 do
154+ let! result = readSingleRow conn
155+ results[ i] <- result
156+ let parameters = Dictionary< string, obj>()
157+ for i in 0 .. results.Length-1 do
158+ let randomNumber = Random.Shared.Next( 1 , 10001 )
159+ parameters[ $" @Rn_{i}" ] <- randomNumber
160+ parameters[ $" @Id_{i}" ] <- results[ i]. id
161+ results[ i] <- { results[ i] with randomnumber = randomNumber }
162+ let! _ = conn.ExecuteAsync( batchUpdateString count, parameters)
163+ return ! ctx.WriteJsonChunked results
164+ }
165+
166+ let utf8Const ( s : string ): EndpointHandler =
167+ let result = s |> Encoding.UTF8.GetBytes
168+ fun ctx ->
169+ ctx.SetContentType( " text/plain" )
170+ ctx.WriteBytes( result)
171+
172+ let endpoints =
78173 [|
79- route " /plaintext" <| text " Hello, World!"
174+ route " /plaintext" <| utf8Const " Hello, World!"
80175 route " /json" <| jsonChunked {| message = " Hello, World!" |}
81176 route " /fortunes"
177+ route " /db"
178+ route " /queries/{count?}"
179+ route " /updates/{count?}"
82180 |]
83181
84182
85183module Main =
184+ open SpanJson
185+ open Microsoft.AspNetCore .Http
86186 open Microsoft.AspNetCore .Builder
87187 open Microsoft.AspNetCore .Hosting
88188 open Microsoft.Extensions .DependencyInjection
89- open Oxpecker
90189 open Microsoft.Extensions .Hosting
91190 open Microsoft.Extensions .Logging
191+ open System.Buffers
192+
193+ type SpanJsonSerializer () =
194+ interface Serializers.IJsonSerializer with
195+ member this.Serialize ( value , ctx , chunked ) =
196+ ctx.Response.ContentType <- " application/json"
197+ if chunked then
198+ if ctx.Request.Method <> HttpMethods.Head then
199+ JsonSerializer.Generic.Utf8.SerializeAsync<_>( value, stream = ctx.Response.Body) .AsTask()
200+ else
201+ Task.CompletedTask
202+ else
203+ task {
204+ let buffer = JsonSerializer.Generic.Utf8.SerializeToArrayPool<_>( value)
205+ ctx.Response.Headers.ContentLength <- buffer.Count
206+ if ctx.Request.Method <> HttpMethods.Head then
207+ do ! ctx.Response.Body.WriteAsync( buffer)
208+ ArrayPool< byte>. Shared.Return( buffer.Array)
209+ else
210+ return ()
211+ }
212+ member this.Deserialize _ =
213+ failwith " Not implemented"
92214
93215 [<EntryPoint>]
94216 let main args =
95-
96217 let builder = WebApplication.CreateBuilder( args)
97-
98218 builder.Services
99219 .AddRouting()
100- .AddOxpecker() |> ignore
101-
220+ .AddOxpecker()
221+ .AddSingleton< Serializers.IJsonSerializer>( SpanJsonSerializer())
222+ |> ignore
102223 builder.Logging.ClearProviders() |> ignore
103- builder.WebHost.ConfigureKestrel( fun options -> options.AllowSynchronousIO <- true ) |> ignore
104-
105224 let app = builder.Build()
106-
107225 app.UseRouting()
108226 .UseOxpecker HttpHandlers.endpoints |> ignore
109-
110227 app.Run()
111-
112228 0
0 commit comments