🐦 Falco v5.x (#9580)

frameworks/FSharp/falco/README.md

@@ -1,11 +1,12 @@
 # Falco Tests on Linux
+
 This includes tests for plaintext, json, and fortunes HTML serialization.
 
 ## Infrastructure Software Versions
 
 **Language**
 
-* F# 6.0
+* F# 6.0 (or greater)
 
 **Platforms**
 
@@ -18,11 +19,10 @@ This includes tests for plaintext, json, and fortunes HTML serialization.
 **Web Stack**
 
 * [Falco](https://github.com/pimbrouwers/Falco)
-* [Donald](https://github.com/pimbrouwers/Donald)
 * ASP.NET Core
 
 ## Paths & Source for Tests
 
-* [Plaintext](src/App/Value.fs): "/plaintext"
-* [JSON serialization](src/App/Value.fs): "/json"
-* [Fortunes using Donald](src/App/Fortune.fs): "/fortunes"
+* [Plaintext](src/App/Program.fs): "/plaintext"
+* [JSON serialization](src/App/Program.fs): "/json"
+* [Fortunes using Donald](src/App/Program.fs): "/fortunes"

frameworks/FSharp/falco/benchmark_config.json

@@ -18,7 +18,7 @@
         "webserver": "Kestrel",
         "os": "Linux",
         "database_os": "Linux",
-        "display_name": "Falco, Donald",
+        "display_name": "Falco",
         "notes": "",
         "versus": "aspcore"
       }

frameworks/FSharp/falco/falco.dockerfile

@@ -1,12 +1,12 @@
-FROM mcr.microsoft.com/dotnet/sdk:7.0.100 AS build
+FROM mcr.microsoft.com/dotnet/sdk:9.0.100 AS build
 WORKDIR /app
 COPY src/App .
 RUN dotnet publish -c Release -o out
 
-FROM mcr.microsoft.com/dotnet/aspnet:7.0 AS runtime
+FROM mcr.microsoft.com/dotnet/aspnet:9.0 AS runtime
 # Full PGO
-ENV DOTNET_TieredPGO 1 
-ENV DOTNET_TC_QuickJitForLoops 1 
+ENV DOTNET_TieredPGO 1
+ENV DOTNET_TC_QuickJitForLoops 1
 ENV DOTNET_ReadyToRun 0
 
 ENV ASPNETCORE_URLS http://+:8080

frameworks/FSharp/falco/src/App/App.fsproj

@@ -1,7 +1,7 @@
 <Project Sdk="Microsoft.NET.Sdk.Web">
 
   <PropertyGroup>
-    <TargetFramework>net7.0</TargetFramework>
+    <TargetFramework>net9.0</TargetFramework>
     <DebugType>portable</DebugType>
     <AssemblyName>App</AssemblyName>
     <OutputType>Exe</OutputType>
@@ -11,17 +11,12 @@
   </PropertyGroup>
 
   <ItemGroup>
-    <Compile Include="UI.fs" />
-    <Compile Include="Fortune.fs" />
-    <Compile Include="Server.fs" />
     <Compile Include="Program.fs" />
   </ItemGroup>
 
   <ItemGroup>
-    <PackageReference Update="FSharp.Core" Version="7.0.0" />
-    <PackageReference Include="Donald" Version="3.0.*" />
-    <PackageReference Include="Falco" Version="2.0.*" />
-    <PackageReference Include="Npgsql" Version="8.0.3" />
+    <PackageReference Include="Falco" Version="5.*" />
+    <PackageReference Include="Npgsql" Version="9.*" />
   </ItemGroup>
 
 </Project>

frameworks/FSharp/falco/src/App/Fortune.fs

@@ -1,83 +0,0 @@
-module App.Fortune    
-
-open System.Data
-open System.Threading.Tasks     
-open Donald
-open Falco
- 
-type FortuneModel = 
-   {
-       id      : int
-       message : string
-   }
-
-module FortuneModel =
-   let fromDataReader (rd : IDataReader) =
-       {
-           id = rd.GetInt32("id")
-           message = rd.GetString("message")
-       }
-
-module Service = 
-    module ListQuery =              
-        type LoadFortunes = unit -> Task<FortuneModel list>
-
-        let extraFortune = 
-            {
-                id = 0
-                message = "Additional fortune added at request time."
-            }
-
-        let handle
-            (loadFortunes : LoadFortunes) =
-            fun () -> 
-                task {
-                    let! fortunes = loadFortunes ()
-                    
-                    return 
-                        extraFortune 
-                        :: fortunes
-                        |> List.sortBy (fun f -> f.message)
-                }
-
-
-module Db =    
-    let selectAsync (connection : IDbConnection) : Task<FortuneModel list> =        
-        queryAsync 
-            "SELECT id, message FROM fortune"
-            []
-            FortuneModel.fromDataReader
-            connection
-
-module View =
-    open Falco.Markup
-    
-    let index (fortunes : FortuneModel list) =            
-        UI.layout "Fortunes" [
-                Elem.table [] [
-                        yield Elem.tr [] [
-                                Elem.th [] [ Text.raw "id" ]
-                                Elem.th [] [ Text.raw "message" ]
-                            ]
-                        for fortune in fortunes ->
-                            Elem.tr [] [
-                                    Elem.td [] [ Text.raw (string fortune.id) ]
-                                    Elem.td [] [ Text.enc fortune.message]
-                                ]
-                    ]
-            ]
-
-let handleIndex : HttpHandler =        
-    fun ctx ->
-        task {
-            let connFactory = ctx.GetService<DbConnectionFactory>()
-            use conn = createConn connFactory
-            let selectFortunes = fun () -> Db.selectAsync conn
-            let! fortunes = () |> Service.ListQuery.handle selectFortunes
-
-            return!
-                ctx
-                |> (fortunes 
-                    |> View.index 
-                    |> Response.ofHtml)                    
-        } :> Task

frameworks/FSharp/falco/src/App/Program.fs

@@ -1,7 +1,12 @@
 module Program
 
+open System.Data
 open Falco
-open App
+open Falco.Markup
+open Falco.Routing
+open Microsoft.AspNetCore.Builder
+open Microsoft.Extensions.Logging
+open Npgsql
 
 [<Literal>]
 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"
@@ -9,16 +14,86 @@ let connectionString = "Server=tfb-database;Database=hello_world;User Id=benchma
 [<Literal>]
 let defaultMsg = "Hello, World!"
 
-type JsonModel = { message : string }
+type JsonResponse =
+    { message : string }
+
+type Fortune =
+    { id : int
+      message : string }
+
+    static member Default =
+        { id = 0
+          message = "Additional fortune added at request time." }
+
+let handleFortunes (connStr : string) : HttpHandler = fun ctx -> task {
+    use conn = new NpgsqlConnection(connStr)
+
+    use comd = conn.CreateCommand()
+    comd.CommandText <- "SELECT id, message FROM fortune"
+
+    do! conn.OpenAsync()
+    use! redr = comd.ExecuteReaderAsync(CommandBehavior.SequentialAccess)
+
+    let! dbFortunes =
+        task {
+            let mutable shouldContinue = true
+            let fortunes = ResizeArray<Fortune>()
+
+            while shouldContinue do
+                let! fortunesRead = redr.ReadAsync()
+
+                if not fortunesRead then
+                    shouldContinue <- false
+                else
+                    fortunes.Add { id = redr.GetInt32(0)
+                                   message = redr.GetString(1) }
+            return fortunes |> List.ofSeq
+        }
+
+    redr.Dispose()
+    comd.Dispose()
+    conn.Dispose()
+
+    let sortedFortunes =
+        Fortune.Default ::
+        dbFortunes
+        |> List.sortBy (fun f -> f.message)
+
+    let html =
+        Elem.html [] [
+            Elem.head [] [
+                    Elem.title [] [ Text.raw "Fortunes" ]
+                ]
+            Elem.body [] [
+                Elem.table [] [
+                        yield Elem.tr [] [
+                                Elem.th [] [ Text.raw "id" ]
+                                Elem.th [] [ Text.raw "message" ]
+                            ]
+                        for fortune in sortedFortunes ->
+                            Elem.tr [] [
+                                    Elem.td [] [ Text.raw (string fortune.id) ]
+                                    Elem.td [] [ Text.enc fortune.message]
+                                ]
+                    ]
+            ]
+        ]
+
+    return Response.ofHtml html ctx
+}
 
 [<EntryPoint>]
-let main args =        
-    Host.startWebHost 
-        args        
-        (Server.configure connectionString)
-        [
-            get "/plaintext"  (Response.ofPlainText defaultMsg)
-            get "/json"       (Response.ofJson { message = defaultMsg })
-            get "/fortunes"   Fortune.handleIndex
-        ]    
+let main args =
+    let bldr  = WebApplication.CreateBuilder(args)
+    bldr.Logging.ClearProviders() |> ignore
+
+    let wapp = bldr.Build()
+
+    wapp.UseRouting()
+        .UseFalco([
+            get "/plaintext" (Response.ofPlainText defaultMsg)
+            get "/json" (Response.ofJson { message = defaultMsg })
+            get "/fortunes" (handleFortunes connectionString)
+        ])
+        .Run()
     0

frameworks/FSharp/falco/src/App/Server.fs

@@ -1,47 +0,0 @@
-module App.Server
-
-open System.Data
-open Donald
-open Falco
-open Falco.Host
-open Microsoft.AspNetCore.Builder
-open Microsoft.AspNetCore.Hosting
-open Microsoft.Extensions.DependencyInjection
-open Microsoft.Extensions.Logging
-open Npgsql
-
-type ConnectionString = string
-type ConfigureLogging = ILoggingBuilder -> unit
-type ConfigureServices = DbConnectionFactory -> IServiceCollection -> unit
-type ConfigureApp = HttpEndpoint list -> IApplicationBuilder -> unit
-type ConfigureServer = ConnectionString -> ConfigureWebHost
-
-let configure : ConfigureServer =
-    let configureLogging : ConfigureLogging =
-        fun log ->
-            log.ClearProviders()
-            |> ignore
-
-    let configureServices : ConfigureServices =
-        fun connectionFactory services ->
-            services
-                .AddRouting() 
-                .AddSingleton<DbConnectionFactory>(connectionFactory)
-            |> ignore
-
-    let configure : ConfigureApp =         
-        fun endpoints app ->
-            app.UseRouting()
-               .UseHttpEndPoints(endpoints)       
-               |> ignore 
-
-    fun connectionString endpoints webHost ->    
-        let connectionFactory =     
-            fun () -> new NpgsqlConnection(connectionString) :> IDbConnection
-    
-        webHost
-            .UseKestrel()
-            .ConfigureLogging(configureLogging)
-            .ConfigureServices(configureServices connectionFactory)
-            .Configure(configure endpoints)
-            |> ignore

frameworks/FSharp/falco/src/App/UI.fs

@@ -1,11 +0,0 @@
-module App.UI
-
-open Falco.Markup
-    
-let layout pageTitle content = 
-    Elem.html [] [
-        Elem.head [] [                
-                Elem.title [] [ Text.raw pageTitle ]                                                                
-            ]
-        Elem.body [] content
-    ]