diff --git a/.paket/Paket.Restore.targets b/.paket/Paket.Restore.targets new file mode 100644 index 00000000..4deb15bc --- /dev/null +++ b/.paket/Paket.Restore.targets @@ -0,0 +1,557 @@ + + + + + + + $(MSBuildAllProjects);$(MSBuildThisFileFullPath) + + $(MSBuildVersion) + 15.0.0 + false + true + + true + $(MSBuildThisFileDirectory) + $(MSBuildThisFileDirectory)..\ + $(PaketRootPath)paket-files\paket.restore.cached + $(PaketRootPath)paket.lock + classic + proj + assembly + native + /Library/Frameworks/Mono.framework/Commands/mono + mono + + + $(PaketRootPath)paket.bootstrapper.exe + $(PaketToolsPath)paket.bootstrapper.exe + $([System.IO.Path]::GetDirectoryName("$(PaketBootStrapperExePath)"))\ + + "$(PaketBootStrapperExePath)" + $(MonoPath) --runtime=v4.0.30319 "$(PaketBootStrapperExePath)" + + + + + true + true + + + True + + + False + + $(BaseIntermediateOutputPath.TrimEnd('\').TrimEnd('\/')) + + + + + + + + + $(PaketRootPath)paket + $(PaketToolsPath)paket + + + + + + $(PaketRootPath)paket.exe + $(PaketToolsPath)paket.exe + + + + + + <_DotnetToolsJson Condition="Exists('$(PaketRootPath)/.config/dotnet-tools.json')">$([System.IO.File]::ReadAllText("$(PaketRootPath)/.config/dotnet-tools.json")) + <_ConfigContainsPaket Condition=" '$(_DotnetToolsJson)' != ''">$(_DotnetToolsJson.Contains('"paket"')) + <_ConfigContainsPaket Condition=" '$(_ConfigContainsPaket)' == ''">false + + + + + + + + + + + <_PaketCommand>dotnet paket + + + + + + $(PaketToolsPath)paket + $(PaketBootStrapperExeDir)paket + + + paket + + + + + <_PaketExeExtension>$([System.IO.Path]::GetExtension("$(PaketExePath)")) + <_PaketCommand Condition=" '$(_PaketCommand)' == '' AND '$(_PaketExeExtension)' == '.dll' ">dotnet "$(PaketExePath)" + <_PaketCommand Condition=" '$(_PaketCommand)' == '' AND '$(OS)' != 'Windows_NT' AND '$(_PaketExeExtension)' == '.exe' ">$(MonoPath) --runtime=v4.0.30319 "$(PaketExePath)" + <_PaketCommand Condition=" '$(_PaketCommand)' == '' ">"$(PaketExePath)" + + + + + + + + + + + + + + + + + + + + + true + $(NoWarn);NU1603;NU1604;NU1605;NU1608 + false + true + + + + + + + + + $([System.IO.File]::ReadAllText('$(PaketRestoreCacheFile)')) + + + + + + + $([System.Text.RegularExpressions.Regex]::Split(`%(Identity)`, `": "`)[0].Replace(`"`, ``).Replace(` `, ``)) + $([System.Text.RegularExpressions.Regex]::Split(`%(Identity)`, `": "`)[1].Replace(`"`, ``).Replace(` `, ``)) + + + + + %(PaketRestoreCachedKeyValue.Value) + %(PaketRestoreCachedKeyValue.Value) + + + + + true + false + true + + + + + true + + + + + + + + + + + + + + + + + + + $(PaketIntermediateOutputPath)\$(MSBuildProjectFile).paket.references.cached + + $(MSBuildProjectFullPath).paket.references + + $(MSBuildProjectDirectory)\$(MSBuildProjectName).paket.references + + $(MSBuildProjectDirectory)\paket.references + + false + true + true + references-file-or-cache-not-found + + + + + $([System.IO.File]::ReadAllText('$(PaketReferencesCachedFilePath)')) + $([System.IO.File]::ReadAllText('$(PaketOriginalReferencesFilePath)')) + references-file + false + + + + + false + + + + + true + target-framework '$(TargetFramework)' or '$(TargetFrameworks)' files @(PaketResolvedFilePaths) + + + + + + + + + + + false + true + + + + + + + + + + + $([System.String]::Copy('%(PaketReferencesFileLines.Identity)').Split(',').Length) + $([System.String]::Copy('%(PaketReferencesFileLines.Identity)').Split(',')[0]) + $([System.String]::Copy('%(PaketReferencesFileLines.Identity)').Split(',')[1]) + $([System.String]::Copy('%(PaketReferencesFileLines.Identity)').Split(',')[4]) + $([System.String]::Copy('%(PaketReferencesFileLines.Identity)').Split(',')[5]) + $([System.String]::Copy('%(PaketReferencesFileLines.Identity)').Split(',')[6]) + $([System.String]::Copy('%(PaketReferencesFileLines.Identity)').Split(',')[7]) + + + %(PaketReferencesFileLinesInfo.PackageVersion) + All + runtime + $(ExcludeAssets);contentFiles + $(ExcludeAssets);build;buildMultitargeting;buildTransitive + true + true + + + + + $(PaketIntermediateOutputPath)/$(MSBuildProjectFile).paket.clitools + + + + + + + + + $([System.String]::Copy('%(PaketCliToolFileLines.Identity)').Split(',')[0]) + $([System.String]::Copy('%(PaketCliToolFileLines.Identity)').Split(',')[1]) + + + %(PaketCliToolFileLinesInfo.PackageVersion) + + + + + + + + + + false + + + + + + <_NuspecFilesNewLocation Include="$(PaketIntermediateOutputPath)\$(Configuration)\*.nuspec"/> + + + + + + $(MSBuildProjectDirectory)/$(MSBuildProjectFile) + true + false + true + false + true + false + true + false + true + false + true + $(PaketIntermediateOutputPath)\$(Configuration) + $(PaketIntermediateOutputPath) + + + + <_NuspecFiles Include="$(AdjustedNuspecOutputPath)\*.$(PackageVersion.Split(`+`)[0]).nuspec"/> + + + + + + + + + + + + + + + + + + + + + + + diff --git a/examples/CORS/Program.fs b/examples/CORS/Program.fs index 8de0ec3f..04cb4a94 100644 --- a/examples/CORS/Program.fs +++ b/examples/CORS/Program.fs @@ -1,27 +1,19 @@ -module Program +module Program -open System -open System.Net open Suave -open Suave.Logging open Suave.Filters -open Suave.Writers -open Suave.Files open Suave.Successful open Suave.CORS -open Suave.State.CookieStateStore -open Suave.Utils open Suave.Operators -let logger = Targets.create Verbose [||] let corsConfig = { defaultCORSConfig with allowedUris = InclusiveOption.Some [ "http://localhost:8085" ] } let app = choose [ GET >=> path "/hello" >=> cors corsConfig >=> OK "CORS request accepted." - ] >=> logStructured logger logFormatStructured + ] [] let main argv = diff --git a/examples/Example/CounterDemo.fs b/examples/Example/CounterDemo.fs index 710ba783..f7bfc8da 100644 --- a/examples/Example/CounterDemo.fs +++ b/examples/Example/CounterDemo.fs @@ -19,8 +19,6 @@ module private Helpers = open Suave open Suave.Sockets -open Suave.Sockets.Control -open Suave.Http open Suave.EventSource open Suave.Utils @@ -29,13 +27,13 @@ open Helpers let counterDemo (req : HttpRequest) (out : Connection) = let write i = - socket { + task { let msg = { id = i; data = string i; ``type`` = None } - do! msg |> send out - return! SocketOp.ofAsync (Async.Sleep 100) + let! _ = send out msg + return! Async.Sleep 100 } - socket { + task { let lastEvtId = (req.header "last-event-id" |> Choice.bind muint32) ((req.queryParam "lastEventId") |> Choice.bind muint32) <.> diff --git a/examples/Example/Program.fs b/examples/Example/Program.fs index 5364462b..7af49160 100644 --- a/examples/Example/Program.fs +++ b/examples/Example/Program.fs @@ -1,11 +1,8 @@ module Program open System -open System.Net open Suave -open Suave.Sockets.Control -open Suave.Logging open Suave.Operators open Suave.EventSource open Suave.Filters @@ -17,31 +14,6 @@ open Suave.State.CookieStateStore let basicAuth = Authentication.authenticateBasic ((=) ("foo", "bar")) -// This demonstrates how to customise the console logger output. -// In most cases you wont need this. Instead you can use the more succinct: -// `let logger = Targets.create Verbose [||]` -let loggingOptions = - { Literate.LiterateOptions.create() with - getLogLevelText = function Verbose->"V" | Debug->"D" | Info->"I" | Warn->"W" | Error->"E" | Fatal->"F" } - -let logger = LiterateConsoleTarget( - name = [|"Suave";"Examples";"Example"|], - minLevel = Verbose, - options = loggingOptions, - outputTemplate = "[{level}] {timestampUtc:o} {message} [{source}]{exceptions}" - ) :> Logger - -/// With this workflow you can write WebParts like this -let task : WebPart = - fun ctx -> WebPart.asyncOption { - let! ctx = GET ctx - let! ctx = Writers.setHeader "foo" "bar" ctx - return ctx - } - -/// we can still use the old symbol but now has a new meaning -let foo : WebPart = fun ctx -> GET ctx >>= OK "hello" - let myApp = choose [ GET >=> choose @@ -57,7 +29,6 @@ let myApp = // typed routes let testApp = choose [ - logStructured logger logFormatStructured >=> never pathScan "/add/%d/%d" (fun (a,b) -> OK((a + b).ToString())) pathScan "/minus/%d/%d" (fun (a,b) -> OK((a - b).ToString())) pathScan "/divide/%d/%d" (fun (a,b) -> OK((a / b).ToString())) @@ -86,9 +57,20 @@ let unzipBody : WebPart = else return ctx } -open System.IO open Suave.Sockets -open Suave.Sockets.Control +open System.IO + +let write (conn:Connection, _) = + task { + use ms = new MemoryStream() + ms.Write([| 1uy; 2uy; 3uy |], 0, 3) + ms.Seek(0L, SeekOrigin.Begin) |> ignore + // do things here + do! conn.asyncWriteLn (sprintf "Content-Length: %d\r\n" ms.Length) + do! conn.flush() + do! transferStream conn ms + return () +} let app = choose [ @@ -99,15 +81,7 @@ let app = path "/hello" >=> OK "Hello World" path "/byte-stream" >=> (fun ctx -> - let write (conn:Connection, _) = socket { - use ms = new MemoryStream() - ms.Write([| 1uy; 2uy; 3uy |], 0, 3) - ms.Seek(0L, SeekOrigin.Begin) |> ignore - // do things here - do! conn.asyncWriteLn (sprintf "Content-Length: %d\r\n" ms.Length) - do! conn.flush() - do! transferStream conn ms - } + { ctx with response = @@ -145,11 +119,12 @@ let app = basicAuth <| choose [ // from here on it will require authentication // surf to: http://localhost:8082/es.html to view the ES GET >=> path "/events2" >=> request (fun _ -> EventSource.handShake (fun out -> - socket { + task { let msg = { id = "1"; data = "First Message"; ``type`` = None } - do! msg |> send out + let! _ = send out msg let msg = { id = "2"; data = "Second Message"; ``type`` = None } - do! msg |> send out + let! _ = send out msg + () })) GET >=> path "/events" >=> request (fun r -> EventSource.handShake (CounterDemo.counterDemo r)) GET >=> browseHome //serves file if exists @@ -177,7 +152,7 @@ let app = >=> OK "Doooooge" RequestErrors.NOT_FOUND "Found no handlers" ] - ] >=> logStructured logger logFormatStructured + ] //>=> logStructured logger logFormatStructured open System.Security.Cryptography.X509Certificates @@ -195,7 +170,7 @@ let main argv = mimeTypesMap = mimeTypes homeFolder = None compressedFilesFolder = None - logger = logger + //logger = logger cookieSerialiser = new BinaryFormatterSerialiser() hideHeader = false maxContentLength = 1000000 } diff --git a/examples/Fibonacci/Program.fs b/examples/Fibonacci/Program.fs index 17216908..ae3cd66e 100644 --- a/examples/Fibonacci/Program.fs +++ b/examples/Fibonacci/Program.fs @@ -1,5 +1,4 @@ -open Suave -open Suave.Http +open Suave open Suave.Filters open Suave.Successful diff --git a/examples/Load/Program.fs b/examples/Load/Program.fs index 16bc8fe5..fa0cdc1b 100644 --- a/examples/Load/Program.fs +++ b/examples/Load/Program.fs @@ -3,20 +3,17 @@ open System.Net open Suave open Suave.Operators -open Suave.Http open Suave.Filters open Suave.Files -open Suave.Logging open System.Threading.Tasks -let logger = Targets.create Verbose [||] let config = { defaultConfig with bindings = [ HttpBinding.createSimple HTTP "127.0.0.1" 8082 ] bufferSize = 2048 maxOps = 10000 - logger = logger } + } let listening, server = startWebServerAsync config (choose [ GET >=> browseHome ]) Task.WaitAll server diff --git a/examples/Stream/Program.fs b/examples/Stream/Program.fs index b9f74a9a..b2a47196 100644 --- a/examples/Stream/Program.fs +++ b/examples/Stream/Program.fs @@ -1,15 +1,12 @@ -module Program +module Program open System.IO open Suave -open Suave.Logging open Suave.Filters open Suave.Stream open Suave.Operators -let logger = Targets.create Verbose [||] - let makeStream = async { let fileStream = File.Open("./kandinsky-composition-8.jpg", FileMode.Open, FileAccess.Read, FileShare.Read) @@ -20,7 +17,7 @@ let makeStream = let app = choose [ GET >=> path "/art" >=> Writers.setMimeType "image/jpeg" >=> okStream makeStream - ] >=> logStructured logger logFormatStructured + ] [] let main argv = diff --git a/examples/WebSocket/Program.fs b/examples/WebSocket/Program.fs index 9459c1e7..22e93e76 100644 --- a/examples/WebSocket/Program.fs +++ b/examples/WebSocket/Program.fs @@ -1,4 +1,3 @@ - open Suave open Suave.Http open Suave.Operators @@ -89,7 +88,7 @@ let app : WebPart = [] let main _ = - startWebServer { defaultConfig with logger = Targets.create Verbose [||] } app + startWebServer defaultConfig app 0 // diff --git a/paket.dependencies b/paket.dependencies index 2b5d5fac..97d9edc4 100644 --- a/paket.dependencies +++ b/paket.dependencies @@ -20,6 +20,8 @@ group Examples nuget FSharp.Core nuget Topshelf.FSharp nuget Topshelf + nuget Microsoft.Extensions.Logging + nuget Microsoft.Extensions.Logging.Console group Docs source https://api.nuget.org/v3/index.json @@ -28,6 +30,8 @@ group Docs nuget Argu nuget FSharp.Core nuget FsLibTool + nuget Microsoft.Extensions.Logging + nuget Microsoft.Extensions.Logging.Console group SourceLink source https://api.nuget.org/v3/index.json diff --git a/paket.lock b/paket.lock index 13fa57f3..faf20c65 100644 --- a/paket.lock +++ b/paket.lock @@ -2,132 +2,212 @@ STORAGE: NONE RESTRICTION: == net7.0 NUGET remote: https://api.nuget.org/v3/index.json - BenchmarkDotNet (0.13.5) - BenchmarkDotNet.Annotations (>= 0.13.5) - CommandLineParser (>= 2.4.3) + BenchmarkDotNet (0.13.12) + BenchmarkDotNet.Annotations (>= 0.13.12) + CommandLineParser (>= 2.9.1) Gee.External.Capstone (>= 2.3) Iced (>= 1.17) - Microsoft.CodeAnalysis.CSharp (>= 3.0) + Microsoft.CodeAnalysis.CSharp (>= 4.1) Microsoft.Diagnostics.Runtime (>= 2.2.332302) Microsoft.Diagnostics.Tracing.TraceEvent (>= 3.0.2) Microsoft.DotNet.PlatformAbstractions (>= 3.1.6) - Perfolizer (>= 0.2.1) - System.Management (>= 6.0) - BenchmarkDotNet.Annotations (0.13.5) + Perfolizer (0.2.1) + System.Management (>= 5.0) + BenchmarkDotNet.Annotations (0.14) CommandLineParser (2.9.1) - DotLiquid (2.2.685) - Expecto (9.0.4) - FSharp.Core (>= 4.6) - Mono.Cecil (>= 0.11.3) - Expecto.BenchmarkDotNet (9.0.4) - BenchmarkDotNet (>= 0.12.1) - FSharp.Core (>= 4.6) - Expecto.FsCheck (9.0.4) - Expecto (>= 9.0.4) - FsCheck (>= 2.14.3) - FsCheck (2.16.5) + DotLiquid (2.2.692) + Expecto (10.2.1) + FSharp.Core (>= 7.0.200) + Mono.Cecil (>= 0.11.4 < 1.0) + Expecto.BenchmarkDotNet (10.2.1) + BenchmarkDotNet (>= 0.13.5 < 0.14) + FSharp.Core (>= 7.0.200) + Expecto.FsCheck (10.2.1) + Expecto (>= 10.2.1) + FsCheck (>= 2.16.5 < 3.0) + FsCheck (2.16.6) FSharp.Core (>= 4.2.3) - FSharp.Core (7.0.200) + FSharp.Core (8.0.400) Gee.External.Capstone (2.3) - Iced (1.18) - Microsoft.Bcl.AsyncInterfaces (7.0) + Iced (1.21) Microsoft.CodeAnalysis.Analyzers (3.3.4) - Microsoft.CodeAnalysis.Common (4.5) - Microsoft.CodeAnalysis.Analyzers (>= 3.3.3) - System.Collections.Immutable (>= 6.0) - System.Reflection.Metadata (>= 6.0.1) + Microsoft.CodeAnalysis.Common (4.11) + Microsoft.CodeAnalysis.Analyzers (>= 3.3.4) + System.Collections.Immutable (>= 8.0) + System.Reflection.Metadata (>= 8.0) + Microsoft.CodeAnalysis.CSharp (4.11) + Microsoft.CodeAnalysis.Analyzers (>= 3.3.4) + Microsoft.CodeAnalysis.Common (4.11) + System.Collections.Immutable (>= 8.0) + System.Reflection.Metadata (>= 8.0) + Microsoft.Diagnostics.NETCore.Client (0.2.532401) + Microsoft.Extensions.Logging.Abstractions (>= 6.0.4) + Microsoft.Diagnostics.Runtime (3.1.512801) + Microsoft.Diagnostics.NETCore.Client (>= 0.2.410101) + Microsoft.Diagnostics.Tracing.TraceEvent (3.1.15) + Microsoft.Diagnostics.NETCore.Client (>= 0.2.510501) + Microsoft.Win32.Registry (>= 5.0) + System.Collections.Immutable (>= 8.0) + System.Reflection.Metadata (>= 8.0) + System.Reflection.TypeExtensions (>= 4.7) System.Runtime.CompilerServices.Unsafe (>= 6.0) - System.Text.Encoding.CodePages (>= 6.0) - Microsoft.CodeAnalysis.CSharp (4.5) - Microsoft.CodeAnalysis.Common (4.5) - Microsoft.Diagnostics.NETCore.Client (0.2.410101) - Microsoft.Bcl.AsyncInterfaces (>= 1.1) - Microsoft.Extensions.Logging (>= 2.1.1) - Microsoft.Diagnostics.Runtime (2.3.405304) - Microsoft.Diagnostics.NETCore.Client (>= 0.2.251802) - System.Collections.Immutable (>= 5.0) - System.Runtime.CompilerServices.Unsafe (>= 5.0) - Microsoft.Diagnostics.Tracing.TraceEvent (3.0.8) - System.Runtime.CompilerServices.Unsafe (>= 5.0) Microsoft.DotNet.PlatformAbstractions (3.1.6) - Microsoft.Extensions.DependencyInjection (7.0) - Microsoft.Extensions.DependencyInjection.Abstractions (>= 7.0) - Microsoft.Extensions.DependencyInjection.Abstractions (7.0) - Microsoft.Extensions.FileProviders.Abstractions (7.0) - Microsoft.Extensions.Primitives (>= 7.0) - Microsoft.Extensions.FileProviders.Embedded (7.0.10) - Microsoft.Extensions.FileProviders.Abstractions (>= 7.0) - Microsoft.Extensions.Logging (7.0) - Microsoft.Extensions.DependencyInjection (>= 7.0) - Microsoft.Extensions.DependencyInjection.Abstractions (>= 7.0) - Microsoft.Extensions.Logging.Abstractions (>= 7.0) - Microsoft.Extensions.Options (>= 7.0) - Microsoft.Extensions.Logging.Abstractions (7.0) - Microsoft.Extensions.Options (7.0.1) - Microsoft.Extensions.DependencyInjection.Abstractions (>= 7.0) - Microsoft.Extensions.Primitives (>= 7.0) - Microsoft.Extensions.Primitives (7.0) - Mono.Cecil (0.11.4) + Microsoft.Extensions.DependencyInjection.Abstractions (8.0.1) + Microsoft.Extensions.FileProviders.Abstractions (8.0) + Microsoft.Extensions.Primitives (>= 8.0) + Microsoft.Extensions.FileProviders.Embedded (8.0.8) + Microsoft.Extensions.FileProviders.Abstractions (>= 8.0) + Microsoft.Extensions.Logging.Abstractions (8.0.1) + Microsoft.Extensions.DependencyInjection.Abstractions (>= 8.0.1) + Microsoft.Extensions.Primitives (8.0) + Microsoft.IO.RecyclableMemoryStream (3.0.1) + Microsoft.Win32.Registry (5.0) + System.Security.AccessControl (>= 5.0) + System.Security.Principal.Windows (>= 5.0) + Mono.Cecil (0.11.5) Perfolizer (0.2.1) System.Memory (>= 4.5.3) - System.CodeDom (7.0) - System.Collections.Immutable (7.0) - System.IO.Pipelines (7.0) - System.Management (7.0) - System.CodeDom (>= 7.0) + System.CodeDom (8.0) + System.Collections.Immutable (8.0) + System.IO.Pipelines (8.0) + System.Management (8.0) + System.CodeDom (>= 8.0) System.Memory (4.5.5) - System.Reactive (5.0) - System.Reflection.Metadata (7.0) - System.Collections.Immutable (>= 7.0) + System.Reactive (6.0.1) + System.Reflection.Metadata (8.0) + System.Collections.Immutable (>= 8.0) + System.Reflection.TypeExtensions (4.7) System.Runtime.CompilerServices.Unsafe (6.0) - System.Text.Encoding.CodePages (7.0) - System.Threading.Channels (7.0) - Websocket.Client (4.6.1) - System.Reactive (>= 5.0) - System.Threading.Channels (>= 5.0) + System.Security.AccessControl (6.0.1) + System.Security.Principal.Windows (5.0) + System.Threading.Channels (8.0) + Websocket.Client (5.1.2) + Microsoft.Extensions.Logging.Abstractions (>= 8.0) + Microsoft.IO.RecyclableMemoryStream (>= 3.0) + System.Reactive (>= 6.0) + System.Threading.Channels (>= 8.0) GROUP Docs RESTRICTION: == net7.0 NUGET remote: https://api.nuget.org/v3/index.json - Argu (6.1.1) - FSharp.Core (>= 4.3.2) + Argu (6.2.4) + FSharp.Core (>= 6.0.7) System.Configuration.ConfigurationManager (>= 4.4) - FSharp.Core (7.0.200) + FSharp.Core (8.0.400) FsLibTool (0.1.1) FSharp.Core (>= 4.0.0.1) PPrint (>= 1.4.3) - Microsoft.Win32.SystemEvents (7.0) + Microsoft.Extensions.Configuration (8.0) + Microsoft.Extensions.Configuration.Abstractions (>= 8.0) + Microsoft.Extensions.Primitives (>= 8.0) + Microsoft.Extensions.Configuration.Abstractions (8.0) + Microsoft.Extensions.Primitives (>= 8.0) + Microsoft.Extensions.Configuration.Binder (8.0.2) + Microsoft.Extensions.Configuration.Abstractions (>= 8.0) + Microsoft.Extensions.DependencyInjection (8.0) + Microsoft.Extensions.DependencyInjection.Abstractions (>= 8.0) + Microsoft.Extensions.DependencyInjection.Abstractions (8.0.1) + Microsoft.Extensions.Logging (8.0) + Microsoft.Extensions.DependencyInjection (>= 8.0) + Microsoft.Extensions.Logging.Abstractions (>= 8.0) + Microsoft.Extensions.Options (>= 8.0) + Microsoft.Extensions.Logging.Abstractions (8.0.1) + Microsoft.Extensions.DependencyInjection.Abstractions (>= 8.0.1) + Microsoft.Extensions.Logging.Configuration (8.0) + Microsoft.Extensions.Configuration (>= 8.0) + Microsoft.Extensions.Configuration.Abstractions (>= 8.0) + Microsoft.Extensions.Configuration.Binder (>= 8.0) + Microsoft.Extensions.DependencyInjection.Abstractions (>= 8.0) + Microsoft.Extensions.Logging (>= 8.0) + Microsoft.Extensions.Logging.Abstractions (>= 8.0) + Microsoft.Extensions.Options (>= 8.0) + Microsoft.Extensions.Options.ConfigurationExtensions (>= 8.0) + Microsoft.Extensions.Logging.Console (8.0) + Microsoft.Extensions.DependencyInjection.Abstractions (>= 8.0) + Microsoft.Extensions.Logging (>= 8.0) + Microsoft.Extensions.Logging.Abstractions (>= 8.0) + Microsoft.Extensions.Logging.Configuration (>= 8.0) + Microsoft.Extensions.Options (>= 8.0) + System.Text.Json (>= 8.0) + Microsoft.Extensions.Options (8.0.2) + Microsoft.Extensions.DependencyInjection.Abstractions (>= 8.0) + Microsoft.Extensions.Primitives (>= 8.0) + Microsoft.Extensions.Options.ConfigurationExtensions (8.0) + Microsoft.Extensions.Configuration.Abstractions (>= 8.0) + Microsoft.Extensions.Configuration.Binder (>= 8.0) + Microsoft.Extensions.DependencyInjection.Abstractions (>= 8.0) + Microsoft.Extensions.Options (>= 8.0) + Microsoft.Extensions.Primitives (>= 8.0) + Microsoft.Extensions.Primitives (8.0) PPrint (2.0) FSharp.Core (>= 3.1.2.5) - System.Configuration.ConfigurationManager (7.0) - System.Diagnostics.EventLog (>= 7.0) - System.Security.Cryptography.ProtectedData (>= 7.0) - System.Security.Permissions (>= 7.0) - System.Diagnostics.EventLog (7.0) - System.Drawing.Common (7.0) - Microsoft.Win32.SystemEvents (>= 7.0) - System.Security.Cryptography.ProtectedData (7.0.1) - System.Security.Permissions (7.0) - System.Windows.Extensions (>= 7.0) - System.Windows.Extensions (7.0) - System.Drawing.Common (>= 7.0) + System.Configuration.ConfigurationManager (8.0) + System.Diagnostics.EventLog (>= 8.0) + System.Security.Cryptography.ProtectedData (>= 8.0) + System.Diagnostics.EventLog (8.0) + System.Security.Cryptography.ProtectedData (8.0) + System.Text.Encodings.Web (8.0) + System.Text.Json (8.0.4) + System.Text.Encodings.Web (>= 8.0) GROUP Examples RESTRICTION: == net7.0 NUGET remote: https://api.nuget.org/v3/index.json - FSharp.Core (7.0.200) - Microsoft.NETCore.Platforms (7.0) + FSharp.Core (8.0.400) + Microsoft.Extensions.Configuration (8.0) + Microsoft.Extensions.Configuration.Abstractions (>= 8.0) + Microsoft.Extensions.Primitives (>= 8.0) + Microsoft.Extensions.Configuration.Abstractions (8.0) + Microsoft.Extensions.Primitives (>= 8.0) + Microsoft.Extensions.Configuration.Binder (8.0.2) + Microsoft.Extensions.Configuration.Abstractions (>= 8.0) + Microsoft.Extensions.DependencyInjection (8.0) + Microsoft.Extensions.DependencyInjection.Abstractions (>= 8.0) + Microsoft.Extensions.DependencyInjection.Abstractions (8.0.1) + Microsoft.Extensions.Logging (8.0) + Microsoft.Extensions.DependencyInjection (>= 8.0) + Microsoft.Extensions.Logging.Abstractions (>= 8.0) + Microsoft.Extensions.Options (>= 8.0) + Microsoft.Extensions.Logging.Abstractions (8.0.1) + Microsoft.Extensions.DependencyInjection.Abstractions (>= 8.0.1) + Microsoft.Extensions.Logging.Configuration (8.0) + Microsoft.Extensions.Configuration (>= 8.0) + Microsoft.Extensions.Configuration.Abstractions (>= 8.0) + Microsoft.Extensions.Configuration.Binder (>= 8.0) + Microsoft.Extensions.DependencyInjection.Abstractions (>= 8.0) + Microsoft.Extensions.Logging (>= 8.0) + Microsoft.Extensions.Logging.Abstractions (>= 8.0) + Microsoft.Extensions.Options (>= 8.0) + Microsoft.Extensions.Options.ConfigurationExtensions (>= 8.0) + Microsoft.Extensions.Logging.Console (8.0) + Microsoft.Extensions.DependencyInjection.Abstractions (>= 8.0) + Microsoft.Extensions.Logging (>= 8.0) + Microsoft.Extensions.Logging.Abstractions (>= 8.0) + Microsoft.Extensions.Logging.Configuration (>= 8.0) + Microsoft.Extensions.Options (>= 8.0) + System.Text.Json (>= 8.0) + Microsoft.Extensions.Options (8.0.2) + Microsoft.Extensions.DependencyInjection.Abstractions (>= 8.0) + Microsoft.Extensions.Primitives (>= 8.0) + Microsoft.Extensions.Options.ConfigurationExtensions (8.0) + Microsoft.Extensions.Configuration.Abstractions (>= 8.0) + Microsoft.Extensions.Configuration.Binder (>= 8.0) + Microsoft.Extensions.DependencyInjection.Abstractions (>= 8.0) + Microsoft.Extensions.Options (>= 8.0) + Microsoft.Extensions.Primitives (>= 8.0) + Microsoft.Extensions.Primitives (8.0) + Microsoft.NETCore.Platforms (7.0.4) Microsoft.NETCore.Targets (5.0) Microsoft.Win32.Registry (5.0) System.Security.AccessControl (>= 5.0) System.Security.Principal.Windows (>= 5.0) - Microsoft.Win32.SystemEvents (7.0) + Microsoft.Win32.SystemEvents (8.0) runtime.native.System (4.3.1) Microsoft.NETCore.Platforms (>= 1.1.1) Microsoft.NETCore.Targets (>= 1.1.3) - System.Diagnostics.EventLog (7.0) + System.Diagnostics.EventLog (8.0) System.Globalization (4.3) Microsoft.NETCore.Platforms (>= 1.1) Microsoft.NETCore.Targets (>= 1.1) @@ -181,14 +261,17 @@ NUGET System.Runtime (>= 4.3) System.Runtime.InteropServices (>= 4.3) System.Threading (>= 4.3) - System.Security.AccessControl (6.0) + System.Security.AccessControl (6.0.1) System.Security.Principal.Windows (5.0) - System.ServiceProcess.ServiceController (7.0) - System.Diagnostics.EventLog (>= 7.0) + System.ServiceProcess.ServiceController (8.0) + System.Diagnostics.EventLog (>= 8.0) System.Text.Encoding (4.3) Microsoft.NETCore.Platforms (>= 1.1) Microsoft.NETCore.Targets (>= 1.1) System.Runtime (>= 4.3) + System.Text.Encodings.Web (8.0) + System.Text.Json (8.0.4) + System.Text.Encodings.Web (>= 8.0) System.Threading (4.3) System.Runtime (>= 4.3) System.Threading.Tasks (>= 4.3) @@ -214,209 +297,202 @@ NUGET BlackFox.VsWhere (1.1) FSharp.Core (>= 4.2.3) Microsoft.Win32.Registry (>= 4.7) - Fake.Api.GitHub (6.0) - FSharp.Core (>= 6.0.3) - Octokit (>= 0.50) - Fake.BuildServer.TeamFoundation (6.0) - Fake.Core.Environment (>= 6.0) - Fake.Core.String (>= 6.0) - Fake.Core.Trace (>= 6.0) - Fake.Core.Vault (>= 6.0) - Fake.IO.FileSystem (>= 6.0) - FSharp.Core (>= 6.0.3) - Fake.Core.CommandLineParsing (6.0) + Fake.Api.GitHub (6.1.1) + FSharp.Core (>= 8.0.301) + Octokit (>= 13.0.1) + Fake.BuildServer.TeamFoundation (6.1.1) + Fake.Core.Environment (>= 6.1.1) + Fake.Core.String (>= 6.1.1) + Fake.Core.Trace (>= 6.1.1) + Fake.Core.Vault (>= 6.1.1) + Fake.IO.FileSystem (>= 6.1.1) + FSharp.Core (>= 8.0.301) + Fake.Core.CommandLineParsing (6.1.1) FParsec (>= 1.1.1) - FSharp.Core (>= 6.0.3) - Fake.Core.Context (6.0) - FSharp.Core (>= 6.0.3) - Fake.Core.Environment (6.0) - FSharp.Core (>= 6.0.3) - Fake.Core.FakeVar (6.0) - Fake.Core.Context (>= 6.0) - FSharp.Core (>= 6.0.3) - Fake.Core.Process (6.0) - Fake.Core.Environment (>= 6.0) - Fake.Core.FakeVar (>= 6.0) - Fake.Core.String (>= 6.0) - Fake.Core.Trace (>= 6.0) - Fake.IO.FileSystem (>= 6.0) - FSharp.Core (>= 6.0.3) - System.Collections.Immutable (>= 6.0) - Fake.Core.ReleaseNotes (6.0) - Fake.Core.SemVer (>= 6.0) - Fake.Core.String (>= 6.0) - FSharp.Core (>= 6.0.3) - Fake.Core.SemVer (6.0) - FSharp.Core (>= 6.0.3) - Fake.Core.String (6.0) - FSharp.Core (>= 6.0.3) - Fake.Core.Target (6.0) - Fake.Core.CommandLineParsing (>= 6.0) - Fake.Core.Context (>= 6.0) - Fake.Core.Environment (>= 6.0) - Fake.Core.FakeVar (>= 6.0) - Fake.Core.Process (>= 6.0) - Fake.Core.String (>= 6.0) - Fake.Core.Trace (>= 6.0) + FSharp.Core (>= 8.0.301) + Fake.Core.Context (6.1.1) + FSharp.Core (>= 8.0.301) + Fake.Core.Environment (6.1.1) + FSharp.Core (>= 8.0.301) + Fake.Core.FakeVar (6.1.1) + Fake.Core.Context (>= 6.1.1) + FSharp.Core (>= 8.0.301) + Fake.Core.Process (6.1.1) + Fake.Core.Environment (>= 6.1.1) + Fake.Core.FakeVar (>= 6.1.1) + Fake.Core.String (>= 6.1.1) + Fake.Core.Trace (>= 6.1.1) + Fake.IO.FileSystem (>= 6.1.1) + FSharp.Core (>= 8.0.301) + System.Collections.Immutable (>= 8.0) + Fake.Core.ReleaseNotes (6.1.1) + Fake.Core.SemVer (>= 6.1.1) + Fake.Core.String (>= 6.1.1) + FSharp.Core (>= 8.0.301) + Fake.Core.SemVer (6.1.1) + FSharp.Core (>= 8.0.301) + Fake.Core.String (6.1.1) + FSharp.Core (>= 8.0.301) + Fake.Core.Target (6.1.1) + Fake.Core.CommandLineParsing (>= 6.1.1) + Fake.Core.Context (>= 6.1.1) + Fake.Core.Environment (>= 6.1.1) + Fake.Core.FakeVar (>= 6.1.1) + Fake.Core.Process (>= 6.1.1) + Fake.Core.String (>= 6.1.1) + Fake.Core.Trace (>= 6.1.1) FSharp.Control.Reactive (>= 5.0.2) - FSharp.Core (>= 6.0.3) - Fake.Core.Tasks (6.0) - Fake.Core.Trace (>= 6.0) - FSharp.Core (>= 6.0.3) - Fake.Core.Trace (6.0) - Fake.Core.Environment (>= 6.0) - Fake.Core.FakeVar (>= 6.0) - FSharp.Core (>= 6.0.3) - Fake.Core.Vault (6.0) - FSharp.Core (>= 6.0.3) - Newtonsoft.Json (>= 13.0.1) - Fake.Core.Xml (6.0) - Fake.Core.String (>= 6.0) - FSharp.Core (>= 6.0.3) - Fake.DotNet.AssemblyInfoFile (6.0) - Fake.Core.Environment (>= 6.0) - Fake.Core.String (>= 6.0) - Fake.Core.Trace (>= 6.0) - Fake.IO.FileSystem (>= 6.0) - FSharp.Core (>= 6.0.3) - Fake.DotNet.Cli (6.0) - Fake.Core.Environment (>= 6.0) - Fake.Core.Process (>= 6.0) - Fake.Core.String (>= 6.0) - Fake.Core.Trace (>= 6.0) - Fake.DotNet.MSBuild (>= 6.0) - Fake.DotNet.NuGet (>= 6.0) - Fake.IO.FileSystem (>= 6.0) - FSharp.Core (>= 6.0.3) + FSharp.Core (>= 8.0.301) + Fake.Core.Tasks (6.1.1) + Fake.Core.Trace (>= 6.1.1) + FSharp.Core (>= 8.0.301) + Fake.Core.Trace (6.1.1) + Fake.Core.Environment (>= 6.1.1) + Fake.Core.FakeVar (>= 6.1.1) + FSharp.Core (>= 8.0.301) + Fake.Core.Vault (6.1.1) + FSharp.Core (>= 8.0.301) + Newtonsoft.Json (>= 13.0.3) + Fake.Core.Xml (6.1.1) + Fake.Core.String (>= 6.1.1) + FSharp.Core (>= 8.0.301) + Fake.DotNet.AssemblyInfoFile (6.1.1) + Fake.Core.Environment (>= 6.1.1) + Fake.Core.String (>= 6.1.1) + Fake.Core.Trace (>= 6.1.1) + Fake.IO.FileSystem (>= 6.1.1) + FSharp.Core (>= 8.0.301) + Fake.DotNet.Cli (6.1.1) + Fake.Core.Environment (>= 6.1.1) + Fake.Core.Process (>= 6.1.1) + Fake.Core.String (>= 6.1.1) + Fake.Core.Trace (>= 6.1.1) + Fake.DotNet.MSBuild (>= 6.1.1) + Fake.Dotnet.NuGet (>= 6.1.1) + Fake.IO.FileSystem (>= 6.1.1) + FSharp.Core (>= 8.0.301) Mono.Posix.NETStandard (>= 1.0) - Newtonsoft.Json (>= 13.0.1) - Fake.DotNet.MSBuild (6.0) + Newtonsoft.Json (>= 13.0.3) + Fake.DotNet.MSBuild (6.1.1) BlackFox.VsWhere (>= 1.1) - Fake.Core.Environment (>= 6.0) - Fake.Core.Process (>= 6.0) - Fake.Core.String (>= 6.0) - Fake.Core.Trace (>= 6.0) - Fake.IO.FileSystem (>= 6.0) - FSharp.Core (>= 6.0.3) - MSBuild.StructuredLogger (>= 2.1.545) - Fake.DotNet.NuGet (6.0) - Fake.Core.Environment (>= 6.0) - Fake.Core.Process (>= 6.0) - Fake.Core.SemVer (>= 6.0) - Fake.Core.String (>= 6.0) - Fake.Core.Tasks (>= 6.0) - Fake.Core.Trace (>= 6.0) - Fake.Core.Xml (>= 6.0) - Fake.IO.FileSystem (>= 6.0) - Fake.Net.Http (>= 6.0) - FSharp.Core (>= 6.0.3) - Newtonsoft.Json (>= 13.0.1) - NuGet.Protocol (>= 6.0) - Fake.DotNet.Paket (6.0) - Fake.Core.Process (>= 6.0) - Fake.Core.String (>= 6.0) - Fake.Core.Trace (>= 6.0) - Fake.DotNet.Cli (>= 6.0) - Fake.IO.FileSystem (>= 6.0) - FSharp.Core (>= 6.0.3) - Fake.DotNet.Testing.XUnit2 (6.0) - Fake.Core.Process (>= 6.0) - Fake.Core.String (>= 6.0) - Fake.Core.Trace (>= 6.0) - Fake.IO.FileSystem (>= 6.0) - Fake.Testing.Common (>= 6.0) - FSharp.Core (>= 6.0.3) - Fake.IO.FileSystem (6.0) - Fake.Core.String (>= 6.0) - Fake.Core.Trace (>= 6.0) - FSharp.Core (>= 6.0.3) - Fake.IO.Zip (6.0) - Fake.Core.String (>= 6.0) - Fake.IO.FileSystem (>= 6.0) - FSharp.Core (>= 6.0.3) - Fake.Net.Http (6.0) - Fake.Core.Trace (>= 6.0) - FSharp.Core (>= 6.0.3) - Fake.Testing.Common (6.0) - Fake.Core.Trace (>= 6.0) - FSharp.Core (>= 6.0.3) - Fake.Tools.Git (6.0) - Fake.Core.Environment (>= 6.0) - Fake.Core.Process (>= 6.0) - Fake.Core.SemVer (>= 6.0) - Fake.Core.String (>= 6.0) - Fake.Core.Trace (>= 6.0) - Fake.IO.FileSystem (>= 6.0) - FSharp.Core (>= 6.0.3) + Fake.Core.Environment (>= 6.1.1) + Fake.Core.Process (>= 6.1.1) + Fake.Core.String (>= 6.1.1) + Fake.Core.Trace (>= 6.1.1) + Fake.IO.FileSystem (>= 6.1.1) + FSharp.Core (>= 8.0.301) + MSBuild.StructuredLogger (>= 2.1.815) + Fake.Dotnet.NuGet (6.1.1) + Fake.Core.Environment (>= 6.1.1) + Fake.Core.Process (>= 6.1.1) + Fake.Core.SemVer (>= 6.1.1) + Fake.Core.String (>= 6.1.1) + Fake.Core.Tasks (>= 6.1.1) + Fake.Core.Trace (>= 6.1.1) + Fake.Core.Xml (>= 6.1.1) + Fake.IO.FileSystem (>= 6.1.1) + Fake.Net.Http (>= 6.1.1) + FSharp.Core (>= 8.0.301) + Newtonsoft.Json (>= 13.0.3) + NuGet.Protocol (>= 6.10.1) + Fake.DotNet.Paket (6.1.1) + Fake.Core.Process (>= 6.1.1) + Fake.Core.String (>= 6.1.1) + Fake.Core.Trace (>= 6.1.1) + Fake.DotNet.Cli (>= 6.1.1) + Fake.IO.FileSystem (>= 6.1.1) + FSharp.Core (>= 8.0.301) + Fake.DotNet.Testing.XUnit2 (6.1.1) + Fake.Core.Process (>= 6.1.1) + Fake.Core.String (>= 6.1.1) + Fake.Core.Trace (>= 6.1.1) + Fake.IO.FileSystem (>= 6.1.1) + Fake.Testing.Common (>= 6.1.1) + FSharp.Core (>= 8.0.301) + Fake.IO.FileSystem (6.1.1) + Fake.Core.String (>= 6.1.1) + Fake.Core.Trace (>= 6.1.1) + FSharp.Core (>= 8.0.301) + Fake.IO.Zip (6.1.1) + Fake.Core.String (>= 6.1.1) + Fake.IO.FileSystem (>= 6.1.1) + FSharp.Core (>= 8.0.301) + Fake.Net.Http (6.1.1) + Fake.Core.Trace (>= 6.1.1) + FSharp.Core (>= 8.0.301) + Fake.Testing.Common (6.1.1) + Fake.Core.Trace (>= 6.1.1) + FSharp.Core (>= 8.0.301) + Fake.Tools.Git (6.1.1) + Fake.Core.Environment (>= 6.1.1) + Fake.Core.Process (>= 6.1.1) + Fake.Core.SemVer (>= 6.1.1) + Fake.Core.String (>= 6.1.1) + Fake.Core.Trace (>= 6.1.1) + Fake.IO.FileSystem (>= 6.1.1) + FSharp.Core (>= 8.0.301) FParsec (1.1.1) FSharp.Core (>= 4.3.4) FSharp.Control.Reactive (5.0.5) FSharp.Core (>= 4.7.2) System.Reactive (>= 5.0 < 6.0) - FSharp.Core (7.0.200) - Microsoft.Build.Framework (17.5) + FSharp.Core (8.0.400) + Microsoft.Build.Framework (17.11.4) Microsoft.Win32.Registry (>= 5.0) - System.Security.Permissions (>= 6.0) - Microsoft.Build.Utilities.Core (17.5) - Microsoft.Build.Framework (>= 17.5) - Microsoft.NET.StringTools (>= 17.5) + System.Memory (>= 4.5.5) + System.Runtime.CompilerServices.Unsafe (>= 6.0) + System.Security.Principal.Windows (>= 5.0) + Microsoft.Build.Utilities.Core (17.11.4) + Microsoft.Build.Framework (>= 17.11.4) + Microsoft.NET.StringTools (>= 17.11.4) Microsoft.Win32.Registry (>= 5.0) - System.Collections.Immutable (>= 6.0) - System.Configuration.ConfigurationManager (>= 6.0) - System.Security.Permissions (>= 6.0) - System.Text.Encoding.CodePages (>= 6.0) - Microsoft.NET.StringTools (17.5) + System.Collections.Immutable (>= 8.0) + System.Configuration.ConfigurationManager (>= 8.0) + System.Memory (>= 4.5.5) + System.Runtime.CompilerServices.Unsafe (>= 6.0) + System.Security.Principal.Windows (>= 5.0) + System.Text.Encoding.CodePages (>= 7.0) + Microsoft.NET.StringTools (17.11.4) System.Memory (>= 4.5.5) System.Runtime.CompilerServices.Unsafe (>= 6.0) Microsoft.Win32.Registry (5.0) System.Security.AccessControl (>= 5.0) System.Security.Principal.Windows (>= 5.0) - Microsoft.Win32.SystemEvents (7.0) Mono.Posix.NETStandard (1.0) - MSBuild.StructuredLogger (2.1.787) - Microsoft.Build.Framework (>= 16.10) - Microsoft.Build.Utilities.Core (>= 16.10) - Newtonsoft.Json (13.0.2) - NuGet.Common (6.5) - NuGet.Frameworks (>= 6.5) - NuGet.Configuration (6.5) - NuGet.Common (>= 6.5) + MSBuild.StructuredLogger (2.2.337) + Microsoft.Build.Framework (>= 17.5) + Microsoft.Build.Utilities.Core (>= 17.5) + Newtonsoft.Json (13.0.3) + NuGet.Common (6.11) + NuGet.Frameworks (>= 6.11) + NuGet.Configuration (6.11) + NuGet.Common (>= 6.11) System.Security.Cryptography.ProtectedData (>= 4.4) - NuGet.Frameworks (6.5) - NuGet.Packaging (6.5) - Newtonsoft.Json (>= 13.0.1) - NuGet.Configuration (>= 6.5) - NuGet.Versioning (>= 6.5) - System.Security.Cryptography.Cng (>= 5.0) - System.Security.Cryptography.Pkcs (>= 5.0) - NuGet.Protocol (6.5) - NuGet.Packaging (>= 6.5) - NuGet.Versioning (6.5) - Octokit (5.0) - System.Collections.Immutable (7.0) + NuGet.Frameworks (6.11) + NuGet.Packaging (6.11) + Newtonsoft.Json (>= 13.0.3) + NuGet.Configuration (>= 6.11) + NuGet.Versioning (>= 6.11) + System.Security.Cryptography.Pkcs (>= 6.0.4) + NuGet.Protocol (6.11) + NuGet.Packaging (>= 6.11) + NuGet.Versioning (6.11) + Octokit (13.0.1) + System.Collections.Immutable (8.0) System.Runtime.CompilerServices.Unsafe (>= 6.0) - System.Configuration.ConfigurationManager (7.0) - System.Security.Cryptography.ProtectedData (>= 7.0) - System.Security.Permissions (>= 7.0) - System.Drawing.Common (7.0) - Microsoft.Win32.SystemEvents (>= 7.0) - System.Formats.Asn1 (7.0) + System.Configuration.ConfigurationManager (8.0) + System.Security.Cryptography.ProtectedData (>= 8.0) + System.Formats.Asn1 (8.0.1) System.Memory (4.5.5) System.Reactive (5.0) System.Runtime.CompilerServices.Unsafe (6.0) - System.Security.AccessControl (6.0) - System.Security.Cryptography.Cng (5.0) - System.Formats.Asn1 (>= 5.0) - System.Security.Cryptography.Pkcs (7.0.1) - System.Formats.Asn1 (>= 7.0) - System.Security.Cryptography.ProtectedData (7.0.1) - System.Security.Permissions (7.0) - System.Windows.Extensions (>= 7.0) + System.Security.AccessControl (6.0.1) + System.Security.Cryptography.Pkcs (8.0) + System.Formats.Asn1 (>= 8.0) + System.Security.Cryptography.ProtectedData (8.0) System.Security.Principal.Windows (5.0) - System.Text.Encoding.CodePages (7.0) + System.Text.Encoding.CodePages (8.0) System.Runtime.CompilerServices.Unsafe (>= 6.0) - System.Windows.Extensions (7.0) - System.Drawing.Common (>= 7.0) GROUP SourceLink STORAGE: NONE diff --git a/src/Suave.IO/Program.fs b/src/Suave.IO/Program.fs index 0b6b540f..c8da1134 100644 --- a/src/Suave.IO/Program.fs +++ b/src/Suave.IO/Program.fs @@ -1,14 +1,22 @@ -module Suave.IO.Program +module Suave.IO.Program open Argu open Suave open Suave.ServerErrors -open Suave.Logging -open Suave.Logging.Message +open Suave.Operators + open System.IO -open System.Net +open Microsoft.Extensions.Logging +open Suave.Filters + +let factory = LoggerFactory.Create(fun builder -> builder.AddConsole() |> ignore) +let logger = factory.CreateLogger("Suave.IO") -let logger = Log.create "Suave.IO" +let log format : WebPart = + fun ctx -> async{ + logger.LogInformation(format ctx); + return Some ctx + } type Arguments = | [] Binding of string * int @@ -26,7 +34,7 @@ let addExnLogging (fwp: 'a -> WebPart) = try return! fwp input ctx with e -> - do logger.fatal (eventX "Unhandled {exception}" >> setField "exception" e) + do logger.LogCritical ("Unhandled exception", e) return! INTERNAL_ERROR "Unhandled internal exception" ctx } @@ -35,7 +43,7 @@ let app: WebPart = Files.browseHome Files.browseFileHome "index.html" request (fun r -> INTERNAL_ERROR (sprintf "No file found at path %s" r.url.AbsolutePath)) - ] + ] >=> log logFormat; [] let main argv = diff --git a/src/Suave.IO/paket.references b/src/Suave.IO/paket.references index d1fc3721..c8497965 100644 --- a/src/Suave.IO/paket.references +++ b/src/Suave.IO/paket.references @@ -1,3 +1,5 @@ group Docs FSharp.Core Argu +Microsoft.Extensions.Logging +Microsoft.Extensions.Logging.Console diff --git a/src/Suave.Tests/Auth.fs b/src/Suave.Tests/Auth.fs index 8adfbb4f..8dca6d85 100644 --- a/src/Suave.Tests/Auth.fs +++ b/src/Suave.Tests/Auth.fs @@ -1,4 +1,4 @@ -module Suave.Tests.Auth +module Suave.Tests.Auth open System @@ -6,8 +6,6 @@ open System.Net open System.Net.Http open Expecto open Suave -open Suave.Logging -open Suave.Logging.Message open Suave.Cookie open Suave.State.CookieStateStore open Suave.Operators @@ -38,29 +36,12 @@ let reqResp fResult (ctx : SuaveTestCtx) = - let event message = - eventX message >> setSingleName "Suave.Tests" - - let logger = - ctx.suaveConfig.logger - - logger.debug ( - event "{method} {resource}" - >> setFieldValue "method" methd - >> setFieldValue "resource" resource) - let defaultTimeout = TimeSpan.FromSeconds 5. use handler = createHandler DecompressionMethods.None cookies use client = createClient handler use request = createRequest methd resource "" None (endpointUri ctx.suaveConfig) |> fRequest - for h in request.Headers do - logger.debug (event "{headerName}: {headerValue}" - >> setFieldValue "headerName" h.Key - >> setFieldValue "headerValue" (String.Join(", ", h.Value))) - - // use -> let!!! let result = request |> send client defaultTimeout ctx fResult result @@ -95,7 +76,7 @@ let sessionState f = [] let authTests cfg = - let runWithConfig = runWith { cfg with logger = Targets.create Warn [||] } + let runWithConfig = runWith cfg //{ cfg with logger = Targets.create Warn [||] } testList "auth tests" [ testCase "baseline, no auth cookie" <| fun _ -> let ctx = runWithConfig (OK "ACK") diff --git a/src/Suave.Tests/CORS.fs b/src/Suave.Tests/CORS.fs index 165fa1db..f2b6dc96 100644 --- a/src/Suave.Tests/CORS.fs +++ b/src/Suave.Tests/CORS.fs @@ -1,17 +1,12 @@ -module Suave.Tests.CORS +module Suave.Tests.CORS -open System open System.Net open System.Net.Http open Expecto -open Suave.Tests.TestUtilities open Suave open Suave.Successful open Suave.Operators open Suave.Filters -open Suave.Logging -open Suave.Cookie -open Suave.State.CookieStateStore open Suave.CORS open Suave.Testing @@ -39,7 +34,7 @@ let corsWithDefaultConfig = cors defaultCORSConfig [] let tests cfg = - let runWithConfig = runWith { cfg with logger = Targets.create LogLevel.Warn [| "Suave"; "Tests"; "CORS" |] } + let runWithConfig = runWith cfg //{ cfg with logger = Targets.create LogLevel.Warn [| "Suave"; "Tests"; "CORS" |] } let origin = "http://someorigin.com" diff --git a/src/Suave.Tests/Cookie.fs b/src/Suave.Tests/Cookie.fs index d0438821..0e0cfc5c 100644 --- a/src/Suave.Tests/Cookie.fs +++ b/src/Suave.Tests/Cookie.fs @@ -1,14 +1,10 @@ -module Suave.Tests.Cookie +module Suave.Tests.Cookie open Suave open Suave.Cookie -open Suave.Logging -open Suave.Testing open Expecto -open FsCheck - open Tests.TestUtilities [] @@ -69,11 +65,6 @@ let parseResultCookie (_:SuaveConfig) = let parsed = Cookie.parseResultCookie (HttpCookie.toHeader cookie) Expect.equal parsed cookie "eq" -// FsCheck character gen from RFC slightly painful; let's do that when merging Freya -// testPropertyWithConfig fscheck_config "anything generated" <| fun (cookie : HttpCookie) -> -// let parsed = Cookie.parse_cookie (HttpCookie.to_header cookie) -// Expect.equal parsed cookie "eq" - testCase "set cookie (same name) twice keeps last" <| fun _ -> let force = Async.RunSynchronously >> Option.get let c1 = HttpCookie.createKV "a" "aa" @@ -105,50 +96,4 @@ let parseRequestCookies (_ : SuaveConfig) = Expect.equal result [] "cookies should be ignored" ] -[] -let setCookie (_ : SuaveConfig) = - testList "set cookie" [ - testCase "set cookie - no warning when < 4k" <| fun _ -> - let log = InspectableLog() - let cookie = - { name = "test cookie" - value = String.replicate 4095 "x" - expires = None - path = Some "/" - domain = None - secure = true - httpOnly = false - sameSite = None } - let ctx = Cookie.setCookie cookie { HttpContext.empty with runtime = { HttpRuntime.empty with logger = log }} - Expect.isTrue (List.isEmpty log.logs) "Should be no logs generated" - testCase "set cookie - no warning when = 4k" <| fun _ -> - let log = InspectableLog() - let cookie = - { name = "test cookie" - value = String.replicate 4096 "x" - expires = None - path = Some "/" - domain = None - secure = true - httpOnly = false - sameSite = None } - let ctx = Cookie.setCookie cookie { HttpContext.empty with runtime = { HttpRuntime.empty with logger = log }} - Expect.isTrue (List.isEmpty log.logs) "Should be no logs generated" - testCase "set cookie - warning when > 4k" <| fun _ -> - let log = InspectableLog() - let cookie = - { name = "test cookie" - value = String.replicate 4097 "x" - expires = None - path = Some "/" - domain = None - secure = true - httpOnly = false - sameSite = None } - let ctx = - let input = { HttpContext.empty with runtime = { HttpRuntime.empty with logger = log }} - Cookie.setCookie cookie input |> Async.RunSynchronously - Expect.equal (List.length log.logs) 1 "Should be 1 log generated" - Expect.equal (List.head log.logs).level LogLevel.Warn "should be a warning" - ] diff --git a/src/Suave.Tests/ExpectoExtensions.fs b/src/Suave.Tests/ExpectoExtensions.fs index ffe1146b..f2a525cc 100644 --- a/src/Suave.Tests/ExpectoExtensions.fs +++ b/src/Suave.Tests/ExpectoExtensions.fs @@ -1,10 +1,9 @@ -module Suave.Tests.ExpectoExtensions +module Suave.Tests.ExpectoExtensions open Expecto -open Expecto.Tests +open Expecto.Logging open Expecto.Impl open System -open System.Linq open System.Reflection type MemberInfo with @@ -68,5 +67,5 @@ let defaultMainThisAssemblyWithParam param args = | None -> failwith "Found no tests." match ExpectoConfig.fillFromArgs defaultConfig args with - | ArgsRun cfg -> runTests cfg tests + | ArgsRun cfg -> runTestsWithCLIArgs [ Verbosity Verbose; Sequenced ] [| |] tests | _ -> 1 \ No newline at end of file diff --git a/src/Suave.Tests/Program.fs b/src/Suave.Tests/Program.fs index 5097c602..a3a5cd1b 100644 --- a/src/Suave.Tests/Program.fs +++ b/src/Suave.Tests/Program.fs @@ -2,8 +2,6 @@ module Suave.Tests.Program open System open Suave -open Suave.Web -open Suave.Logging open ExpectoExtensions [] @@ -19,14 +17,6 @@ let main args = let testConfig = { defaultConfig with bindings = [ HttpBinding.createSimple HTTP "127.0.0.1" 9001 ] - logger = Targets.create Warn [| "Suave"; "Tests" |] } - - let mutable firstRun = 0 - let runDefaultEngine() = - Console.WriteLine "Running tests with default TCP engine." - firstRun <- defaultMainThisAssemblyWithParam testConfig args - Console.WriteLine "Done." - - runDefaultEngine() - firstRun + } + defaultMainThisAssemblyWithParam testConfig args diff --git a/src/Suave.Tests/Suave.Tests.fsproj b/src/Suave.Tests/Suave.Tests.fsproj index aed24f34..6c5d3107 100644 --- a/src/Suave.Tests/Suave.Tests.fsproj +++ b/src/Suave.Tests/Suave.Tests.fsproj @@ -41,9 +41,7 @@ - - diff --git a/src/Suave.Tests/TestUtilities.fs b/src/Suave.Tests/TestUtilities.fs index dc514707..d2c26076 100644 --- a/src/Suave.Tests/TestUtilities.fs +++ b/src/Suave.Tests/TestUtilities.fs @@ -1,4 +1,4 @@ -module Suave.Tests.TestUtilities +module Suave.Tests.TestUtilities #nowarn "25" @@ -164,7 +164,7 @@ module Expect = module Assert = let Equal(msg, exp, act) = Expect.equal act exp msg - + (* type LogMethod = | Factory of (LogLevel -> Message) | Plain of Message @@ -190,3 +190,4 @@ type InspectableLog() = member x.logWithAck level msgFactory : Async = x.logs <- { level = level; value = Factory msgFactory } :: x.logs async.Return () + *) \ No newline at end of file diff --git a/src/Suave.Tests/Testing.fs b/src/Suave.Tests/Testing.fs index eef72a1e..565e9ecf 100644 --- a/src/Suave.Tests/Testing.fs +++ b/src/Suave.Tests/Testing.fs @@ -31,8 +31,8 @@ open System.Net.Http open System.Net.Http.Headers open Expecto open Suave -open Suave.Logging -open Suave.Logging.Message +//open Suave.Logging +//open Suave.Logging.Message open Suave.Http [] @@ -105,7 +105,7 @@ let runWithFactory factory config webParts : SuaveTestCtx = let config2 = { config with cancellationToken = cts.Token; bufferSize = 128; maxOps = 10 } - let listening, (server) = factory { config with cancellationToken = cts .Token; logger = Targets.create Warn [||] } webParts + let listening, (server) = factory { config with cancellationToken = cts .Token(*; logger = Targets.create Warn [||]*) } webParts listening |> Async.RunSynchronously |> ignore // wait for the server to start listening { cts = cts @@ -143,10 +143,10 @@ let createClient handler = /// Send the request with the client - returning the result of the request let send (client : HttpClient) (timeout : TimeSpan) (ctx : SuaveTestCtx) (request : HttpRequestMessage) = - ctx.suaveConfig.logger.verbose ( - eventX "Send" - >> setFieldValue "method" request.Method.Method - >> setFieldValue "uri" request.RequestUri) + //ctx.suaveConfig.logger.verbose ( + // eventX "Send" + //>> setFieldValue "method" request.Method.Method + // >> setFieldValue "uri" request.RequestUri) let send = client.SendAsync(request, HttpCompletionOption.ResponseContentRead, ctx.cts.Token) diff --git a/src/Suave.Tests/Web.fs b/src/Suave.Tests/Web.fs index 78c7aa05..6e34065c 100644 --- a/src/Suave.Tests/Web.fs +++ b/src/Suave.Tests/Web.fs @@ -6,13 +6,8 @@ open Suave open Suave.Operators open Suave.Logging open Suave.Testing -open Suave.Sockets.Control -open Suave.Sockets.AsyncSocket open System open System.Net -open System.Net.Http -open System.Threading -open Suave.Http let private (=>) a b = a, b @@ -42,12 +37,11 @@ let parsing_tests (_: SuaveConfig) = Expect.equal (TraceHeader.parseTraceHeaders headers).traceId expected.traceId "should parse trace id" Expect.equal (TraceHeader.parseTraceHeaders headers).reqParentId expected.reqParentId "should parse span id to parent span id" ] -open Suave open Suave.Sockets [] let transferEncodingChunkedTests (cfg : SuaveConfig) = - let writeChunks (conn:Connection) = socket { + let writeChunks (conn:Connection) = task { do! conn.writeChunk "h"B do! conn.writeChunk "e"B diff --git a/src/Suave/Authentication.fs b/src/Suave/Authentication.fs index a2500d91..9e925b68 100644 --- a/src/Suave/Authentication.fs +++ b/src/Suave/Authentication.fs @@ -1,11 +1,8 @@ module Suave.Authentication -open System open System.Text open Suave.RequestErrors open Suave.Utils -open Suave.Logging -open Suave.Logging.Message open Suave.Cookie open Suave.State.CookieStateStore open Suave.Operators @@ -89,9 +86,6 @@ let authenticate relativeExpiry secure : WebPart = context (fun ctx -> - ctx.runtime.logger.debug ( - eventX "Authenticating" - >> setSingleName "Suave.Auth.authenticate") let state = { serverKey = ctx.runtime.serverKey diff --git a/src/Suave/Combinators.fs b/src/Suave/Combinators.fs index 89ac149a..d002a792 100644 --- a/src/Suave/Combinators.fs +++ b/src/Suave/Combinators.fs @@ -2,6 +2,7 @@ namespace Suave open Suave.Operators open Suave.Sockets +open System.Threading.Tasks module Response = @@ -128,7 +129,6 @@ module Intermediate = // 2xx module Successful = open System.Text - open Suave.Utils open Response let ok bytes : WebPart = @@ -288,7 +288,6 @@ module ServerErrors = module Filters = open Suave.Utils.AsyncExtensions - open Suave.Logging open System open System.Text open System.Text.RegularExpressions @@ -380,33 +379,6 @@ module Filters = ] "{clientIp} {processId} {userName} [{utcNow:dd/MMM/yyyy:hh:mm:ss %K}] \"{requestMethod} {requestUrlPath} {httpVersion}\" {httpStatusCode} {responseContentLength}", fieldList |> Map - let logWithLevel (level : LogLevel) (logger : Logger) (messageFun : HttpContext -> string) (ctx : HttpContext) = - async{ - logger.log level (fun _ -> - { value = Event (messageFun ctx) - level = level - name = [| "Suave"; "Http"; "requests" |] - fields = Map.empty - timestamp = Suave.Logging.Global.timestamp() }) - return Some ctx } - - let logWithLevelStructured (level : LogLevel) (logger : Logger) (messageFun : HttpContext -> (string * Map)) (ctx : HttpContext) = - async{ - logger.log level (fun _ -> - let template, fields = messageFun ctx - { value = Event template - level = level - name = [| "Suave"; "Http"; "requests" |] - fields = fields - timestamp = Suave.Logging.Global.timestamp() }) - return Some ctx } - - let logStructured (logger : Logger) (messageFun : HttpContext -> (string * Map)) = - logWithLevelStructured LogLevel.Info logger messageFun - - let log (logger : Logger) (messageFun : HttpContext -> string) = - logWithLevel LogLevel.Info logger messageFun - open Suave.Sscanf let pathScan (pf : PrintfFormat<_,_,_,_,'t>) (h : 't -> WebPart) : WebPart = @@ -463,8 +435,6 @@ module ServeResource = open Redirection open RequestErrors open Suave.Utils - open Suave.Logging - open Suave.Logging.Message // If a response includes both an Expires header and a max-age directive, // the max-age directive overrides the Expires header, even if the Expires header is more restrictive @@ -472,10 +442,6 @@ module ServeResource = let resource key exists getLast getExtension (send : string -> bool -> WebPart) ctx = - let log = - event Verbose - >> setSingleName "Suave.Http.ServeResource.resource" - >> ctx.runtime.logger.logSimple let sendIt name compression = setHeader "Last-Modified" ((getLast key : DateTimeOffset).ToString("R")) @@ -500,11 +466,8 @@ module ServeResource = | Choice2Of2 _ -> sendIt value.name value.compression ctx | None -> - let ext = getExtension key - log ("failed to find matching mime for ext '" + ext + "'") fail else - log ("failed to find resource by key '" + key + "'") fail module ContentRange = @@ -538,45 +501,40 @@ module Files = open System.IO open System.Text - open Suave.Utils - open Suave.Logging - open Suave.Logging.Message - open Suave.Sockets.Control - - open Response - open Writers open Successful - open Redirection open ServeResource open ContentRange let sendFile fileName (compression : bool) (ctx : HttpContext) = let writeFile file = let fs, start, total, status = getFileStream ctx file - fun (conn:Connection, _) -> socket { + fun (conn:Connection, _) -> task { let getLm = fun path -> FileInfo(path).LastWriteTime - let! (encoding,fs) = Compression.transformStream file fs getLm compression ctx.runtime.compressionFolder ctx - let finish = start + fs.Length - 1L - try + match! Compression.transformStream file fs getLm compression ctx.runtime.compressionFolder ctx with + | Ok(encoding,fs) -> + let finish = start + fs.Length - 1L try - match encoding with - | Some n -> - do! conn.asyncWriteLn ("Content-Range: bytes " + start.ToString() + "-" + finish.ToString() + "/*") - do! conn.asyncWriteLn (String.Concat [| "Content-Encoding: "; n.ToString() |]) - do! conn.asyncWriteLn ("Content-Length: " + (fs : Stream).Length.ToString() + "\r\n") - do! conn.flush () - if ctx.request.``method`` <> HttpMethod.HEAD && fs.Length > 0L then - do! transferStream conn fs - | None -> - do! conn.asyncWriteLn ("Content-Range: bytes " + start.ToString() + "-" + finish.ToString() + "/" + total.ToString()) - do! conn.asyncWriteLn ("Content-Length: " + (fs : Stream).Length.ToString() + "\r\n") - do! conn.flush() - if ctx.request.``method`` <> HttpMethod.HEAD && fs.Length > 0L then - do! transferStream conn fs - with ex -> - raise ex - finally - fs.Dispose() + try + match encoding with + | Some n -> + do! conn.asyncWriteLn ("Content-Range: bytes " + start.ToString() + "-" + finish.ToString() + "/*") + do! conn.asyncWriteLn (String.Concat [| "Content-Encoding: "; n.ToString() |]) + do! conn.asyncWriteLn ("Content-Length: " + (fs : Stream).Length.ToString() + "\r\n") + do! conn.flush () + if ctx.request.``method`` <> HttpMethod.HEAD && fs.Length > 0L then + do! transferStream conn fs + | None -> + do! conn.asyncWriteLn ("Content-Range: bytes " + start.ToString() + "-" + finish.ToString() + "/" + total.ToString()) + do! conn.asyncWriteLn ("Content-Length: " + (fs : Stream).Length.ToString() + "\r\n") + do! conn.flush() + if ctx.request.``method`` <> HttpMethod.HEAD && fs.Length > 0L then + do! transferStream conn fs + with ex -> + raise ex + finally + fs.Dispose() + | Result.Error error -> + return failwith "error" }, status let task, status = writeFile fileName { ctx with @@ -614,13 +572,7 @@ module Files = browseFile q.homeDirectory fileName h let browse rootPath : WebPart = - warbler (fun ctx -> - ctx.runtime.logger.verbose ( - eventX "Files.browser trying {localFileUrl} at {rootPath}" - >> setFieldValue "localFileUrl" ctx.request.url.AbsolutePath - >> setFieldValue "rootPath" rootPath - >> setSingleName "Suave.Http.Files.browse") - file (resolvePath rootPath ctx.request.path)) + warbler (fun ctx -> file (resolvePath rootPath ctx.request.path)) let browseHome : WebPart = warbler (fun ctx -> browse ctx.runtime.homeDirectory) @@ -661,11 +613,8 @@ module Embedded = open System.Xml open System.Xml.Linq - open Suave.Utils open Suave.Utils.Option.Operators - open Suave.Sockets.Control - open Response open ServeResource let defaultSourceAssembly = @@ -687,26 +636,29 @@ module Embedded = resourceName (compression : bool) (ctx : HttpContext) = - let writeResource name (conn:Connection, _) = socket { + let writeResource name (conn:Connection, _) = task { let fs = source.GetManifestResourceStream(name) let getLm = fun _ -> lastModified source - let! encoding,fs = Compression.transformStream name fs getLm compression ctx.runtime.compressionFolder ctx - match encoding with - | Some n -> - do! conn.asyncWriteLn (String.Concat [| "Content-Encoding: "; n.ToString() |]) - do! conn.asyncWriteLn ("Content-Length: " + (fs: Stream).Length.ToString() + "\r\n") - do! conn.flush() - if ctx.request.``method`` <> HttpMethod.HEAD && fs.Length > 0L then - do! transferStream conn fs - fs.Dispose() - return () - | None -> - do! conn.asyncWriteLn ("Content-Length: " + (fs: Stream).Length.ToString() + "\r\n") - do! conn.flush () - if ctx.request.``method`` <> HttpMethod.HEAD && fs.Length > 0L then - do! transferStream conn fs - fs.Dispose() - return () + match! Compression.transformStream name fs getLm compression ctx.runtime.compressionFolder ctx with + | Ok (encoding,fs) -> + match encoding with + | Some n -> + do! conn.asyncWriteLn (String.Concat [| "Content-Encoding: "; n.ToString() |]) + do! conn.asyncWriteLn ("Content-Length: " + (fs: Stream).Length.ToString() + "\r\n") + do! conn.flush() + if ctx.request.``method`` <> HttpMethod.HEAD && fs.Length > 0L then + do! transferStream conn fs + fs.Dispose() + return () + | None -> + do! conn.asyncWriteLn ("Content-Length: " + (fs: Stream).Length.ToString() + "\r\n") + do! conn.flush () + if ctx.request.``method`` <> HttpMethod.HEAD && fs.Length > 0L then + do! transferStream conn fs + fs.Dispose() + return () + | Result.Error error -> + return failwith "error" } { ctx with response = @@ -832,7 +784,7 @@ module EventSource = let (<<.) (out : Connection) (data : string) = out.asyncWriteBytes (Encoding.UTF8.GetBytes data) - let dispatch (out : Connection) : SocketOp = + let dispatch (out : Connection) : ValueTask = send out ES_EOL_S let comment (out : Connection) (cmt : string) = @@ -866,7 +818,7 @@ module EventSource = { id = id; data = data; ``type`` = Some typ } let send (out : Connection) (msg : Message) = - socket { + task { do! msg.id |> esId out match msg.``type`` with | Some x -> do! x |> eventType out @@ -876,7 +828,7 @@ module EventSource = } let private handShakeAux f (out : Connection, _) = - socket { + task { do! out.asyncWriteLn "" // newline after headers do! out.flush() // must flush lines buffer before using asyncWriteBytes @@ -886,7 +838,7 @@ module EventSource = return! f out } - let handShake (fCont: Connection -> SocketOp) (ctx : HttpContext) = + let handShake (fCont: Connection -> Task) (ctx : HttpContext) = { ctx with response = { ctx.response with @@ -908,8 +860,8 @@ module TransferEncoding = open Suave open Suave.Sockets.Control - let chunked (asyncWriteChunks: Connection -> SocketOp) (ctx : HttpContext) = - let task (conn:Connection,_) = socket { + let chunked (asyncWriteChunks: Connection -> System.Threading.Tasks.Task) (ctx : HttpContext) = + let task (conn:Connection,_) = task { do! conn.asyncWriteLn "" do! asyncWriteChunks conn } diff --git a/src/Suave/Combinators.fsi b/src/Suave/Combinators.fsi index fc538972..080e808c 100644 --- a/src/Suave/Combinators.fsi +++ b/src/Suave/Combinators.fsi @@ -1,5 +1,6 @@ namespace Suave +open System.Threading.Tasks open Suave.Sockets /// @@ -1153,12 +1154,12 @@ module Filters = /// message formatter that can inspect the context and produce a message to /// send to the logger, along with the structured fields as a name*obj map. /// - val logWithLevelStructured : level:LogLevel -> logger:Logger -> messageFun:(HttpContext -> string * Map) -> WebPart + //val logWithLevelStructured : level:LogLevel -> logger:Logger -> messageFun:(HttpContext -> string * Map) -> WebPart /// /// The function log is equivalent to `logWithLevel LogLevel.Debug`. /// - val logStructured : logger:Logger -> messageFun:(HttpContext -> string * Map) -> WebPart + //val logStructured : logger:Logger -> messageFun:(HttpContext -> string * Map) -> WebPart /// /// The default log format for . NCSA Common log format @@ -1182,12 +1183,12 @@ module Filters = /// message formatter that can inspect the context and produce a message to /// send to the logger. /// - val logWithLevel : level:LogLevel -> logger:Logger -> messageFun:(HttpContext -> string) -> WebPart + //val logWithLevel : level:LogLevel -> logger:Logger -> messageFun:(HttpContext -> string) -> WebPart /// /// The function log is equivalent to `logWithLevel LogLevel.Debug`. /// - val log : logger:Logger -> messageFun:(HttpContext -> string) -> WebPart + //val log : logger:Logger -> messageFun:(HttpContext -> string) -> WebPart /// /// Strongly typed route matching! Matching the uri can be used with the 'parsers' @@ -1603,36 +1604,36 @@ module EventSource = /// the proper framing is used. However, if you have a desire to write raw /// data, this function overrides the Socket.async_write function so that /// you will be writing UTF8 data only, as per the specification. - val asyncWrite : out:Connection -> data:string -> SocketOp + val asyncWrite : out:Connection -> data:string -> Task /// Same as `async_write`; convenience function. - val (<<.) : out:Connection -> data:string -> SocketOp + val (<<.) : out:Connection -> data:string -> Task /// "If the line is empty (a blank line) - dispatch the event." /// Dispatches the event properly to the browser. - val dispatch : out:Connection -> SocketOp + val dispatch : out:Connection -> ValueTask /// "If the line starts with a U+003A COLON character (:) - Ignore the line." /// Writes a comment to the stream - val comment : out:Connection -> cmt:string -> SocketOp + val comment : out:Connection -> cmt:string -> Task /// "If the field name is 'event' - Set the event type buffer to field value." /// Writes the event type to the stream - val eventType : out:Connection -> eventType:string -> SocketOp + val eventType : out:Connection -> eventType:string -> Task /// "If the field name is 'data' - /// Append the field value to the data buffer, then append a single /// U+000A LINE FEED (LF) character to the data buffer." /// Write a piece of data as part of the event - val data : out:Connection -> data:string -> SocketOp + val data : out:Connection -> data:string -> Task /// "If the field name is 'id' - Set the last event ID buffer to the field value." /// Sets the last event id in the stream. - val esId : out:Connection -> lastEventId:string -> SocketOp + val esId : out:Connection -> lastEventId:string -> Task /// Sets the option for the EventSource instance, of how long to wait in ms /// until a new connection is spawned as a retry. - val retry : out:Connection -> retry:uint32 -> SocketOp + val retry : out:Connection -> retry:uint32 -> Task /// A container data type for the output events type Message = @@ -1647,14 +1648,14 @@ module EventSource = static member createType : id:string -> data:string -> typ:string -> Message /// send a message containing data to the output stream - val send : out:Connection -> msg:Message -> SocketOp + val send : out:Connection -> msg:Message -> Task /// This function composes the passed function f with the hand-shake required /// to start a new event-stream protocol session with the browser. - val handShake : fCont:(Connection -> SocketOp) -> WebPart + val handShake : fCont:(Connection -> Task) -> WebPart module TransferEncoding = - val chunked: (Connection -> SocketOp) -> WebPart + val chunked: (Connection -> Task) -> WebPart module Control = diff --git a/src/Suave/Compression.fs b/src/Suave/Compression.fs index aba29768..753c803b 100644 --- a/src/Suave/Compression.fs +++ b/src/Suave/Compression.fs @@ -4,8 +4,6 @@ module Compression = open Suave.Utils open Suave.Sockets - open Suave.Sockets.Control - open System open System.IO @@ -57,8 +55,8 @@ module Compression = | _ -> None) | _ -> None - let transform (content : byte []) (ctx : HttpContext) : SocketOp = - socket { + let transform (content : byte []) (ctx : HttpContext) : Threading.Tasks.Task = + task { if content.Length > MIN_BYTES_TO_COMPRESS && content.Length < MAX_BYTES_TO_COMPRESS then let request = ctx.request let enconding = getEncoder request diff --git a/src/Suave/ConnectionFacade.fs b/src/Suave/ConnectionFacade.fs index 3e378b73..4abea717 100644 --- a/src/Suave/ConnectionFacade.fs +++ b/src/Suave/ConnectionFacade.fs @@ -11,7 +11,6 @@ open Suave open Suave.Utils open Suave.Utils.Parsing open Suave.Logging -open Suave.Logging.Message open Suave.Sockets open Suave.Sockets.Control open Suave.Sockets.SocketOp.Operators @@ -19,7 +18,7 @@ open Suave.Utils.Bytes open System.Threading open System.Threading.Tasks -type ConnectionFacade(connection: Connection, runtime: HttpRuntime, logger:Logger, connectionPool: ConcurrentPool, cancellationToken: CancellationToken,webpart:WebPart) = +type ConnectionFacade(connection: Connection, runtime: HttpRuntime, connectionPool: ConcurrentPool, cancellationToken: CancellationToken,webpart:WebPart) = let httpOutput = new HttpOutput(connection,runtime) @@ -49,7 +48,7 @@ type ConnectionFacade(connection: Connection, runtime: HttpRuntime, logger:Logge let filename = Net.WebUtility.UrlDecode(_filename.Substring(ix + 2)) SocketOp.mreturn (filename) else - SocketOp.abort (InputDataError (None, "Unsupported filename encoding: '" + enc + "'")) + SocketOp.abort (InputDataError (None, "Unsupported filename encoding: '" + enc + "'")) else SocketOp.abort (InputDataError (None, "Invalid filename encoding")) | Choice2Of2 _ -> @@ -84,11 +83,7 @@ type ConnectionFacade(connection: Connection, runtime: HttpRuntime, logger:Logge match partHeaders %% "content-type" with | Choice1Of2 contentType -> let headerParams = headerParams contentDisposition - logger.verbose (eventX "Parsing {contentType}... -> readFilePart" >> setFieldValue "contentType" contentType) - let! res = readFilePart boundary headerParams fieldName contentType - logger.verbose (eventX "Parsed {contentType} <- readFilePart" >> setFieldValue "contentType" contentType) - match res with | Some upload -> files.Add(upload) @@ -113,6 +108,7 @@ type ConnectionFacade(connection: Connection, runtime: HttpRuntime, logger:Logge let parseMultipart (boundary:string) : SocketOp = let parsePart () = socket { let! partHeaders = reader.readHeaders() + let! (contentDisposition : string) = (partHeaders %% "content-disposition") @|! (None, "Missing 'content-disposition'") @@ -123,9 +119,10 @@ type ConnectionFacade(connection: Connection, runtime: HttpRuntime, logger:Logge (headerParams.TryLookup "form-data" |> Choice.map (String.trimc '"')) @|! (None, "Key 'form-data' was not present in 'content-disposition'") - let! fieldName = - (headerParams.TryLookup "name" |> Choice.map (String.trimc '"')) - @|! (None, "Key 'name' was not present in 'content-disposition'") + let fieldName = + match headerParams.TryLookup "name" |> Choice.map (String.trimc '"') with + | Choice1Of2 s -> s + | _ -> failwith "Key 'name' was not present in 'content-disposition'" match partHeaders %% "content-type" with | Choice1Of2 x when String.startsWith "multipart/mixed" x -> @@ -135,16 +132,7 @@ type ConnectionFacade(connection: Connection, runtime: HttpRuntime, logger:Logge return () | Choice1Of2 contentType when headerParams.ContainsKey "filename" -> - logger.verbose ( - eventX "Parsing {contentType}... -> readFilePart" - >> setFieldValue "contentType" contentType - >> setSingleName "Suave.Web.parseMultipart") let! res = readFilePart boundary headerParams fieldName contentType - logger.verbose ( - eventX "Parsed {contentType} <- readFilePart" - >> setFieldValue "contentType" contentType - >> setSingleName "Suave.Web.parseMultipart") - res |> Option.iter files.Add | Choice1Of2 _ | Choice2Of2 _ -> @@ -177,8 +165,7 @@ type ConnectionFacade(connection: Connection, runtime: HttpRuntime, logger:Logge let mutable error = false let result = ref (Ok()) while parsing && not error && not(cancellationToken.IsCancellationRequested) do - let! _line = something () - match _line with + match! something () with | Ok line -> if line.StartsWith("--") then parsing <- false @@ -201,7 +188,7 @@ type ConnectionFacade(connection: Connection, runtime: HttpRuntime, logger:Logge /// Reads raw POST data let getRawPostData contentLength = - socket { + task { let offset = ref 0 let rawForm = Array.zeroCreate contentLength do! reader.readPostData contentLength (fun a count -> @@ -209,55 +196,46 @@ type ConnectionFacade(connection: Connection, runtime: HttpRuntime, logger:Logge let target = new Span(rawForm,!offset,count) source.CopyTo(target) offset := !offset + count) - return rawForm + return Ok (rawForm) } member val Connection = connection with get,set member val Runtime = runtime with get,set - member (*inline*) this.parsePostData maxContentLength (contentLengthHeader : Choice) (contentTypeHeader:Choice) = socket { - match contentLengthHeader with - | Choice1Of2 contentLengthString -> - let contentLength = Convert.ToInt32 contentLengthString - - if contentLength > maxContentLength then - return! SocketOp.abort(InputDataError (Some 413, "Payload too large")) - else - logger.verbose (eventX "Expecting {contentLength} bytes" >> setFieldValue "contentLength" contentLength) - - match contentTypeHeader with - | Choice1Of2 ce when String.startsWith "application/x-www-form-urlencoded" ce -> - let! rawForm = getRawPostData contentLength - _rawForm <- rawForm - return () - - | Choice1Of2 ce when String.startsWith "multipart/form-data" ce -> - let boundary = "--" + parseBoundary ce - - logger.verbose (eventX "Parsing multipart") - do! parseMultipart boundary - logger.verbose (eventX "Done parsing multipart") - return () + member (*inline*) this.parsePostData maxContentLength (contentLengthHeader : Choice) (contentTypeHeader:Choice) : Task>= + socket { + match contentLengthHeader with + | Choice1Of2 contentLengthString -> + let contentLength = Convert.ToInt32 contentLengthString + + if contentLength > maxContentLength then + return! SocketOp.abort(InputDataError (Some 413, "Payload too large")) + else + match contentTypeHeader with + | Choice1Of2 ce when String.startsWith "application/x-www-form-urlencoded" ce -> + let! rawForm = getRawPostData contentLength + _rawForm <- rawForm + | Choice1Of2 ce when String.startsWith "multipart/form-data" ce -> + let boundary = "--" + parseBoundary ce + do! parseMultipart boundary + | Choice1Of2 _ | Choice2Of2 _ -> + let! rawForm = getRawPostData contentLength + _rawForm <- rawForm - | Choice1Of2 _ | Choice2Of2 _ -> - let! rawForm = getRawPostData contentLength - _rawForm <- rawForm return () | Choice2Of2 _ -> return () } /// Process the request, reading as it goes from the incoming 'stream', yielding a HttpRequest /// when done - member (*inline*) this.processRequest () = socket { + member (*inline*) this.readRequest () = socket { - logger.verbose (eventX "reading first line of request") let! firstLine = reader.readLine() - let! rawMethod, path, rawQuery, httpVersion = + let! (rawMethod, path, rawQuery, httpVersion) = parseUrl firstLine - @|! (None, "Invalid ") + @|! (None, "Invalid first line") - logger.verbose (eventX "reading headers") let! headers = reader.readHeaders() // Respond with 400 Bad Request as @@ -266,9 +244,8 @@ type ConnectionFacade(connection: Connection, runtime: HttpRuntime, logger:Logge if headers %% "expect" = Choice1Of2 "100-continue" then let! _ = httpOutput.run HttpRequest.empty Intermediate.CONTINUE - logger.verbose (eventX "sent 100-continue response") + () - logger.verbose (eventX "parsing post data") do! this.parsePostData runtime.maxContentLength (headers %% "content-length") (headers %% "content-type") let request = @@ -284,66 +261,47 @@ type ConnectionFacade(connection: Connection, runtime: HttpRuntime, logger:Logge multiPartFields = Seq.toList multiPartFields trace = TraceHeader.parseTraceHeaders headers } - // clear form data before exit + // Clear form data before exit files.Clear() multiPartFields.Clear() _rawForm <- [||] - return Some request + return request } member this.exitHttpLoopWithError (err:Error) = task{ match err with | InputDataError (None, msg) -> - logger.verbose (eventX "Error parsing HTTP request with {message}" >> setFieldValue "message" msg) match! httpOutput.run HttpRequest.empty (RequestErrors.BAD_REQUEST msg) with - | _ -> - logger.verbose (eventX "Exiting http loop") + | _ -> () | InputDataError (Some status,msg) -> - logger.verbose (eventX "Error parsing HTTP request with {message}" >> setFieldValue "message" msg) match Http.HttpCode.tryParse status with | (Choice1Of2 statusCode) -> match! httpOutput.run HttpRequest.empty (Response.response statusCode (Encoding.UTF8.GetBytes msg)) with - | _ -> logger.verbose (eventX "Exiting http loop") + | _ -> () | (Choice2Of2 err) -> - logger.warn (eventX "Invalid HTTP status code {statusCode}" >> setFieldValue "statusCode" status) match! httpOutput.run HttpRequest.empty (RequestErrors.BAD_REQUEST msg) with - | _ -> - logger.verbose (eventX "Exiting http loop") - | err -> - logger.verbose (eventX "Socket error while processing request, exiting {error}" >> setFieldValue "error" err) + | _ -> () + | err -> () return Ok(false) } - member this.loop () = + member this.processRequest () = task { - logger.verbose (eventX "Processing request... -> processor") - let! result' = this.processRequest () - logger.verbose (eventX "Processed request. <- processor") - match result' with - | Ok result -> - match result with - | None -> - logger.verbose (eventX "'result = None', exiting") - return Ok (false) - | Some request -> - try - match! httpOutput.run request webpart with - | Result.Error err -> - return Result.Error err - | Ok keepAlive -> - if keepAlive then - logger.verbose (eventX "'Connection: keep-alive' recurse") - return Ok (keepAlive) - else - logger.verbose (eventX "Connection: close") - return Ok(false) - with ex -> - return Result.Error (Error.ConnectionError ex.Message) + match! this.readRequest () with | Result.Error err -> // Couldn't parse HTTP request; answering with BAD_REQUEST and closing the connection. return! this.exitHttpLoopWithError err + | Ok request -> + try + match! httpOutput.run request webpart with + | Result.Error err -> + return Result.Error err + | Ok keepAlive -> + return Ok (keepAlive) + with ex -> + return Result.Error (Error.ConnectionError ex.Message) } member this.shutdown() = @@ -360,7 +318,7 @@ type ConnectionFacade(connection: Connection, runtime: HttpRuntime, logger:Logge let flag = ref true let result = ref (Ok ()) while !flag && not (cancellationToken.IsCancellationRequested) do - let! b = this.loop () + let! b = this.processRequest () match b with | Ok b -> flag := b @@ -373,21 +331,21 @@ type ConnectionFacade(connection: Connection, runtime: HttpRuntime, logger:Logge member this.accept(binding) = task{ Interlocked.Increment Globals.numberOfClients |> ignore - logger.verbose (eventX "{client} connected. Now has {totalClients} connected" - >> setFieldValue "client" (binding.ip.ToString()) - >> setFieldValue "totalClients" (!Globals.numberOfClients)) + let clientIp = (binding.ip.ToString()) + if Globals.verbose then + Console.WriteLine("{0} connected. Now has {1} connected", clientIp,(!Globals.numberOfClients)) connection.socketBinding <- binding try let task = Task.Factory.StartNew(reader.readLoop,cancellationToken) let! a = this.requestLoop() () with - | :? System.IO.EndOfStreamException -> - logger.debug (eventX "Disconnected client (end of stream)") - logger.verbose (eventX "Shutting down transport") - this.shutdown() + | ex -> + if reader.isDirty then + reader.stop() + do Console.WriteLine("Error: " + ex.Message) Interlocked.Decrement(Globals.numberOfClients) |> ignore - logger.verbose (eventX "Disconnected {client}. {totalClients} connected." - >> setFieldValue "client" (binding.ip.ToString()) - >> setFieldValue "totalClients" (!Globals.numberOfClients)) + if Globals.verbose then + do Console.WriteLine("Disconnected {0}. {1} connected.", clientIp,(!Globals.numberOfClients)) + do this.shutdown() } diff --git a/src/Suave/Cookie.fs b/src/Suave/Cookie.fs index ee7c29fd..b80a45fe 100644 --- a/src/Suave/Cookie.fs +++ b/src/Suave/Cookie.fs @@ -3,11 +3,8 @@ namespace Suave module Cookie = open System - open System.Text open System.Globalization open Suave.Operators - open Suave.Logging - open Suave.Logging.Message open Suave.Utils type CookieLife = @@ -123,13 +120,6 @@ module Cookie = (Headers.Fields.Response.setCookie, header) :: headers) (ctx.response.headers |> List.filter notSetCookie) - if cookie.value.Length > 4096 then - ctx.runtime.logger.warn ( - eventX "Cookie {cookieName} has {cookieBytes} which is too large! Lengths over 4 096 bytes risk corruption in some browsers; consider alternate storage" - >> setFieldValue "cookieName" cookie.name - >> setFieldValue "cookieBytes" cookie.value.Length) - - succeed { ctx with response = { ctx.response with headers = headers' } } @@ -139,15 +129,7 @@ module Cookie = Writers.addHeader Headers.Fields.Response.setCookie stringValue let setPair (httpCookie : HttpCookie) (clientCookie : HttpCookie) : WebPart = - context (fun ctx -> - ctx.runtime.logger.debug ( - eventX "Setting {cookieName} to value of {cookieBytes}" - >> setFieldValue "cookieName" httpCookie.name - >> setFieldValue "cookieBytes" httpCookie.value.Length - >> setSingleName "Suave.Cookie.setPair") - - succeed) - >=> setCookie httpCookie + setCookie httpCookie >=> setCookie clientCookie let unsetPair httpCookieName : WebPart = @@ -209,19 +191,14 @@ module Cookie = let updateCookies (csctx : CookiesState) fPlainText : WebPart = context (fun ctx -> - let debug message = - ctx.runtime.logger.debug ( - eventX message - >> setSingleName "Suave.Cookie.updateCookies") - let plainText = match readCookies csctx.serverKey csctx.cookieName ctx.response.cookies with | Choice1Of2 (_, plainText) -> - debug "Existing cookie" + //debug "Existing cookie" fPlainText (Some plainText) | Choice2Of2 _ -> - debug "First time" + //debug "First time" fPlainText None // Since the contents will completely change every write, we simply re-generate the cookie @@ -238,9 +215,6 @@ module Cookie = (fSuccess : WebPart) : WebPart = context (fun ctx -> - let debug message = - ctx.runtime.logger.debug (eventX message >> setSingleName "Suave.Cookie.cookieState") - let setCookies plainText = let httpCookie, clientCookie = generateCookies csctx.serverKey csctx.cookieName @@ -252,7 +226,6 @@ module Cookie = match readCookies csctx.serverKey csctx.cookieName ctx.request.cookies with | Choice1Of2 (httpCookie, plainText) -> - debug "Existing cookie" refreshCookies csctx.relativeExpiry httpCookie >=> Writers.setUserData csctx.userStateKey plainText >=> fSuccess @@ -260,19 +233,14 @@ module Cookie = | Choice2Of2 (NoCookieFound _) -> match noCookie () with | Choice1Of2 plainText -> - debug "No existing cookie, setting text" setCookies plainText >=> fSuccess | Choice2Of2 wp_kont -> - debug "No existing cookie, calling WebPart continuation" wp_kont | Choice2Of2 (DecryptionError err) -> - debug ("decryption error: " + err.ToString()) match decryptionFailure err with | Choice1Of2 plainText -> - debug "Existing, broken cookie, setting cookie text anew" setCookies plainText >=> fSuccess | Choice2Of2 wpKont -> - debug "Existing, broken cookie, unsetting it, forwarding to given failure web part" wpKont >=> unsetPair csctx.cookieName) diff --git a/src/Suave/Globals.fs b/src/Suave/Globals.fs index 44d0a400..ffcd18a2 100644 --- a/src/Suave/Globals.fs +++ b/src/Suave/Globals.fs @@ -27,10 +27,26 @@ let SuaveVersion = Assembly.GetExecutingAssembly().GetName().Version.ToString() /// This is the server header let ServerHeader = "Server: Suave (https://suave.io)" +let mutable verbose = false + +open System.Diagnostics + +[] +type Logger = + + [] + static member debug (s:string) : unit = + Console.WriteLine s + + static member info (s:string) : unit = + Console.WriteLine s + + [] [] [] [] [] [] + do () \ No newline at end of file diff --git a/src/Suave/Http.fs b/src/Suave/Http.fs index 71dd51b7..09cb9899 100644 --- a/src/Suave/Http.fs +++ b/src/Suave/Http.fs @@ -369,7 +369,7 @@ module Http = type HttpContent = | NullContent | Bytes of byte [] - | SocketTask of (Connection * HttpResult -> SocketOp) + | SocketTask of (Connection * HttpResult -> Threading.Tasks.Task) and [] HttpResult = { status : HttpStatus @@ -383,7 +383,6 @@ module Http = mimeTypesMap : MimeTypesMap homeDirectory : string compressionFolder : string - logger : Logger matchedBinding : HttpBinding cookieSerialiser : CookieSerialiser hideHeader : bool @@ -476,20 +475,18 @@ module Http = mimeTypesMap = fun _ -> None homeDirectory = "." compressionFolder = "." - logger = Targets.create Debug [| "Suave" |] matchedBinding = HttpBinding.defaults cookieSerialiser = new BinaryFormatterSerialiser() hideHeader = false maxContentLength = 1024 } let create serverKey errorHandler mimeTypes homeDirectory compressionFolder - logger cookieSerialiser hideHeader maxContentLength binding = + (*logger*) cookieSerialiser hideHeader maxContentLength binding = { serverKey = serverKey errorHandler = errorHandler mimeTypesMap = mimeTypes homeDirectory = homeDirectory compressionFolder = compressionFolder - logger = logger matchedBinding = binding cookieSerialiser = cookieSerialiser hideHeader = hideHeader diff --git a/src/Suave/Http.fsi b/src/Suave/Http.fsi index 8bd0ad6b..ae60ca29 100644 --- a/src/Suave/Http.fsi +++ b/src/Suave/Http.fsi @@ -230,7 +230,7 @@ module Http = /// control the flow of bytes by using a `SocketOp`. Contrasting with `Bytes`, /// setting the `HttpContent` as this discriminated union type lets you stream /// data back to the client through Suave. - | SocketTask of (Connection * HttpResult -> SocketOp) + | SocketTask of (Connection * HttpResult -> Threading.Tasks.Task) /// The `HttpResult` is the structure that you work with to tell Suave how to @@ -257,7 +257,7 @@ module Http = mimeTypesMap : MimeTypesMap homeDirectory : string compressionFolder : string - logger : Logger + //logger : Logger matchedBinding : HttpBinding cookieSerialiser : CookieSerialiser hideHeader : bool @@ -337,7 +337,7 @@ module Http = /// make a new `HttpRuntime` from the given parameters val create : serverKey:ServerKey -> errorHandler:ErrorHandler -> mimeTypes:MimeTypesMap -> homeDirectory:string - -> compressionFolder:string -> logger:Logger + -> compressionFolder:string (*-> logger:Logger*) -> cookieSerialiser:CookieSerialiser -> hideHeader:bool -> maxContentLength:int -> binding:HttpBinding diff --git a/src/Suave/HttpOutput.fs b/src/Suave/HttpOutput.fs index 0710cb95..314d0b2f 100644 --- a/src/Suave/HttpOutput.fs +++ b/src/Suave/HttpOutput.fs @@ -3,9 +3,6 @@ namespace Suave open System.Collections.Generic open Suave.Utils open Suave.Sockets -open Suave.Sockets.Control -open Suave.Logging -open Suave.Logging.Message open System @@ -33,12 +30,12 @@ type HttpOutput(connection: Connection, runtime: HttpRuntime) = ; userState = new Dictionary() ; response = HttpResult.empty } - member (*inline*) this.writeContentType (headers : (string*string) list) = socket { + member (*inline*) this.writeContentType (headers : (string*string) list) = task { if not(List.exists(fun (x : string,_) -> x.ToLower().Equals("content-type")) headers )then return! connection.asyncWriteBufferedBytes ByteConstants.defaultContentTypeHeaderBytes } - member (*inline*) this.writeContentLengthHeader (content : byte[]) (context : HttpContext) = socket { + member (*inline*) this.writeContentLengthHeader (content : byte[]) (context : HttpContext) = task { match context.request.``method``, context.response.status.code with | (_, 100) | (_, 101) @@ -53,13 +50,15 @@ type HttpOutput(connection: Connection, runtime: HttpRuntime) = return! connection.asyncWriteBufferedArrayBytes [| ByteConstants.contentLengthBytes; ASCII.bytes (content.Length.ToString()); ByteConstants.EOLEOL |] } - member (*inline*) this.writeHeaders exclusions (headers : (string*string) seq) = socket { - for x,y in headers do + member (*inline*) this.writeHeaders exclusions (headers : (string*string) seq) = task { + use sourceEnumerator = headers.GetEnumerator() + while sourceEnumerator.MoveNext() do + let x,y = sourceEnumerator.Current if not (List.exists (fun y -> x.ToLower().Equals(y)) exclusions) then do! connection.asyncWriteLn (String.Concat [| x; ": "; y |]) } - member this.writePreamble (response:HttpResult) = socket { + member this.writePreamble (response:HttpResult) = task { let r = response let preamble = [| ByteConstants.httpVersionBytes; ASCII.bytes (r.status.code.ToString()); @@ -75,8 +74,8 @@ type HttpOutput(connection: Connection, runtime: HttpRuntime) = } member (*inline*) this.writeContent writePreamble context = function - | Bytes b -> socket { - let! (encoding, content : byte []) = Compression.transform b context + | Bytes b -> task { + let! (encoding, content : byte []) = Compression.transform b context match encoding with | Some n -> do! connection.asyncWriteLn (String.Concat [| "Content-Encoding: "; n.ToString() |]) @@ -98,10 +97,10 @@ type HttpOutput(connection: Connection, runtime: HttpRuntime) = else do! connection.flush() } - | SocketTask f -> socket{ + | SocketTask f -> task{ do! f (connection, context.response) } - | NullContent -> socket { + | NullContent -> task { if writePreamble then do! this.writeContentLengthHeader [||] context do! connection.flush() @@ -118,7 +117,7 @@ type HttpOutput(connection: Connection, runtime: HttpRuntime) = } member this.writeResponse (newCtx:HttpContext) = - socket{ + task{ if newCtx.response.writePreamble then do! this.writePreamble newCtx.response do! this.writeContent true newCtx newCtx.response.content @@ -133,30 +132,19 @@ type HttpOutput(connection: Connection, runtime: HttpRuntime) = try freshContext.request <- request freshContext.userState.Clear() - //Console.WriteLine "before calling webpart" let task = webPart freshContext - //Console.WriteLine "after calling webpart" - //Console.WriteLine "before Execute task" match! this.executeTask task with | Some ctx -> - //Console.WriteLine "before writeresponse" - match! this.writeResponse ctx with - | Ok () -> - //Console.WriteLine "after writeresponse" - let keepAlive = - match ctx.request.header "connection" with - | Choice1Of2 conn -> - String.equalsOrdinalCI conn "keep-alive" - | Choice2Of2 _ -> - ctx.request.httpVersion.Equals("HTTP/1.1") - //Console.WriteLine "exiting httpOutput.run" - return Ok (keepAlive) - | Result.Error err -> - ctx.runtime.logger.error (eventX "Socket error while writing response {error}" >> setFieldValue "error" err) - return Result.Error err + let! _ = this.writeResponse ctx + let keepAlive = + match ctx.request.header "connection" with + | Choice1Of2 conn -> + String.equalsOrdinalCI conn "keep-alive" + | Choice2Of2 _ -> + ctx.request.httpVersion.Equals("HTTP/1.1") + return Ok (keepAlive) | None -> return Ok (false) with ex -> - //Console.WriteLine "nother one bytes the doost" return Result.Error(Error.ConnectionError ex.Message) } diff --git a/src/Suave/Proxy.fs b/src/Suave/Proxy.fs index 4cb1b015..afb55dd3 100644 --- a/src/Suave/Proxy.fs +++ b/src/Suave/Proxy.fs @@ -7,7 +7,6 @@ open Suave.Utils open Suave.Operators open Suave.Successful open Suave.Sockets -open Suave.Sockets.Control let private (?) headers (name : string) = headers @@ -25,7 +24,7 @@ let private httpWebResponseToHttpContext (ctx : HttpContext) (response : HttpWeb |> Seq.map (fun k -> k, response.Headers.Get k) |> Seq.toList - let writeContentLengthHeader (conn:Connection) = socket { + let writeContentLengthHeader (conn:Connection) = task { match headers ? ("Content-Length") with | Some x -> do! conn.asyncWriteLn (sprintf "Content-Length: %s" x) @@ -36,7 +35,7 @@ let private httpWebResponseToHttpContext (ctx : HttpContext) (response : HttpWeb let content = SocketTask - (fun (conn, _) -> socket { + (fun (conn, _) -> task { do! writeContentLengthHeader conn do! conn.asyncWriteLn "" do! conn.flush() @@ -103,12 +102,6 @@ let proxy (newHost : Uri) : WebPart = return httpWebResponseToHttpContext ctx response |> Some | exn -> - ctx.runtime.logger.log - Logging.Error - (fun lvl -> - Logging.Message.event lvl (sprintf "Unable to proxy the request %A %A. " ctx.request.rawMethod remappedAddress) - |> Logging.Message.addExn exn) - return! ( OK "Unable to proxy the request. " diff --git a/src/Suave/Sockets/AsyncSocket.fs b/src/Suave/Sockets/AsyncSocket.fs index 2fd9794a..0ccfca52 100644 --- a/src/Suave/Sockets/AsyncSocket.fs +++ b/src/Suave/Sockets/AsyncSocket.fs @@ -10,63 +10,45 @@ open System open System.IO open System.Text -let transferStreamWithBuffer (buf: ArraySegment<_>) (toStream : Connection) (from : Stream) : SocketOp = +let transferStreamWithBuffer (buf: ArraySegment<_>) (toStream : Connection) (from : Stream) = task { - try let reading = ref true - let error = ref false - let errorResult = ref (Ok()) - while !reading && not !error do + while !reading do let! read = from.ReadAsync (buf.Array, 0, buf.Array.Length) if read <= 0 then reading := false else let! a = send toStream (new Memory<_>(buf.Array, 0, read)) - match a with - | Ok () -> () - | Result.Error e as a -> - error := true - errorResult := a - if !error then - return !errorResult - else - return Ok () - with ex -> - return Result.Error(Error.ConnectionError ex.Message) + () } /// Asynchronously write from the 'from' stream to the 'to' stream. -let transferStream (toStream : Connection) (from : Stream) : SocketOp = - socket { +let transferStream (toStream : Connection) (from : Stream) = + task { let buf = new ArraySegment<_>(Array.zeroCreate 8192) do! transferStreamWithBuffer buf toStream from } let internal zeroCharMemory = new Memory(Encoding.ASCII.GetBytes "0") -let transferStreamChunked (conn : Connection) (from : Stream) : SocketOp = - socket { - let buf = new ArraySegment<_>(Array.zeroCreate 1024) - - let rec doBlock conn = - socket { - let! read = SocketOp.ofAsync <| from.AsyncRead (buf.Array, buf.Offset, buf.Count) - +let transferStreamChunked (conn : Connection) (from : Stream) = + task { + let buf = new ArraySegment<_>(Array.zeroCreate 1024) + let reading = ref true + while !reading do + let! read = from.AsyncRead (buf.Array, buf.Offset, buf.Count) if read <= 0 then - do! send conn zeroCharMemory - do! send conn Bytes.eolMemory - do! send conn Bytes.eolMemory + let! _ = send conn zeroCharMemory + let! _ = send conn Bytes.eolMemory + let! _ = send conn Bytes.eolMemory + reading := false else let readHex = read.ToString("X") - do! send conn (Memory<_>(Encoding.ASCII.GetBytes readHex)) - do! send conn Bytes.eolMemory + let! _ = send conn (Memory<_>(Encoding.ASCII.GetBytes readHex)) + let! _ = send conn Bytes.eolMemory - do! send conn (Memory<_>(buf.Array, buf.Offset, read)) - do! send conn Bytes.eolMemory - - do! doBlock conn - } - - do! doBlock conn - } + let! _ = send conn (Memory<_>(buf.Array, buf.Offset, read)) + let! _ = send conn Bytes.eolMemory + () + } diff --git a/src/Suave/Sockets/Connection.fs b/src/Suave/Sockets/Connection.fs index 0c588e1e..7e90a891 100644 --- a/src/Suave/Sockets/Connection.fs +++ b/src/Suave/Sockets/Connection.fs @@ -25,29 +25,29 @@ type Connection = x.socketBinding.port /// Flush out whatever is in the lineBuffer - member inline this.flush () : SocketOp = - socket { + member inline this.flush () = + task { if this.lineBufferCount> 0 then - do! this.transport.write (new Memory<_>(this.lineBuffer,0,this.lineBufferCount)) + let! _ = this.transport.write (new Memory<_>(this.lineBuffer,0,this.lineBufferCount)) this.lineBufferCount <- 0 } - member inline this.asyncWrite (str: string) : SocketOp = - socket { + member inline this.asyncWrite (str: string) = + task { if str.Length = 0 then return () else let maxByteCount = Encoding.UTF8.GetMaxByteCount(str.Length) if maxByteCount > this.lineBuffer.Length then - do! this.transport.write (new Memory<_>(this.lineBuffer, 0, this.lineBufferCount)) + let! _ = this.transport.write (new Memory<_>(this.lineBuffer, 0, this.lineBufferCount)) let byteCount = Encoding.UTF8.GetBytes(str, 0, str.Length, this.lineBuffer, 0) // don't waste time buffering here - do! this.transport.write (new Memory<_>(this.lineBuffer, 0, byteCount)) + let! _ = this.transport.write (new Memory<_>(this.lineBuffer, 0, byteCount)) this.lineBufferCount <- 0 return () elif this.lineBufferCount + maxByteCount > this.lineBuffer.Length then - do! this.transport.write (new Memory<_>(this.lineBuffer, 0, this.lineBufferCount)) + let! _ = this.transport.write (new Memory<_>(this.lineBuffer, 0, this.lineBufferCount)) // the string, char index, char count, bytes, byte index let c = Encoding.UTF8.GetBytes(str, 0, str.Length, this.lineBuffer, 0) this.lineBufferCount <- 0 @@ -59,37 +59,34 @@ type Connection = return () } - member inline this.asyncWriteLn (s : string) : SocketOp = - socket { - return! this.asyncWrite (s + Bytes.eol) - } + member inline this.asyncWriteLn (s : string) = this.asyncWrite (s + Bytes.eol) /// Write the string s to the stream asynchronously from a byte array - member inline this.asyncWriteBytes (b : byte[]) : SocketOp = + member inline this.asyncWriteBytes (b : byte[]) = task { if b.Length > 0 then - return! this.transport.write (new Memory<_>(b, 0, b.Length)) - else - return Ok () + let! _ = this.transport.write (new Memory<_>(b, 0, b.Length)) + () } - member inline this.asyncWriteBufferedBytes (b : byte[]) : SocketOp = - socket { + member inline this.asyncWriteBufferedBytes (b : byte[]) = + task { if this.lineBufferCount + b.Length > this.lineBuffer.Length then // flush lineBuffer if this.lineBufferCount > 0 then - do! this.transport.write (new Memory<_>(this.lineBuffer, 0, this.lineBufferCount)) + let! _ = this.transport.write (new Memory<_>(this.lineBuffer, 0, this.lineBufferCount)) + () // don't waste time buffering here - do! this.transport.write (new Memory<_>(b, 0, b.Length)) + let! _ = this.transport.write (new Memory<_>(b, 0, b.Length)) this.lineBufferCount <- 0 else Buffer.BlockCopy(b, 0, this.lineBuffer,this.lineBufferCount, b.Length) this.lineBufferCount <- this.lineBufferCount + b.Length } - member inline this.asyncWriteBufferedArrayBytes (xxs:(byte[])[]) : SocketOp = + member inline this.asyncWriteBufferedArrayBytes (xxs:(byte[])[]) = let rec loop index = - socket{ + task{ if index >= xxs.Length then return () else @@ -98,7 +95,7 @@ type Connection = } loop 0 - member inline this.writeChunk (chunk : byte []) = socket { + member inline this.writeChunk (chunk : byte []) = task { let chunkLength = chunk.Length.ToString("X") do! this.asyncWriteLn chunkLength do! this.asyncWriteLn (System.Text.Encoding.UTF8.GetString(chunk)) diff --git a/src/Suave/Sockets/HttpReader.fs b/src/Suave/Sockets/HttpReader.fs index 7716c38e..7d58a72b 100644 --- a/src/Suave/Sockets/HttpReader.fs +++ b/src/Suave/Sockets/HttpReader.fs @@ -3,6 +3,7 @@ namespace Suave open System open System.Collections.Generic open System.Text +open System.Threading.Tasks open Suave.Sockets open Suave.Sockets.Control @@ -52,22 +53,24 @@ module Aux = type HttpReader(transport : TcpTransport, lineBuffer : byte array, pipe: Pipe, cancellationToken) = let mutable running : bool = true + let mutable dirty : bool = false member this.stop () = + pipe.Writer.Complete() + pipe.Reader.Complete() + pipe.Reset() running <- false + dirty <- false member (*inline*) x.readMoreData () = task { let buff = pipe.Writer.GetMemory() - match! transport.read buff with - | Ok x -> - if x > 0 then - pipe.Writer.Advance(x) - let! flushResult = pipe.Writer.FlushAsync(cancellationToken) - return Ok() - else - return Result.Error (Error.ConnectionError "no more data") - | Result.Error error -> - return Result.Error error + let! x = transport.read buff + if x > 0 then + pipe.Writer.Advance(x) + let! flushResult = pipe.Writer.FlushAsync(cancellationToken) + return Ok() + else + return Result.Error (Error.ConnectionError "no more data") } member (*inline*) x.getData () = task{ @@ -183,7 +186,7 @@ type HttpReader(transport : TcpTransport, lineBuffer : byte array, pipe: Pipe, c let flag = ref true let error = ref false let result = ref (Ok ([])) - while !flag && (not !error) && (not cancellationToken.IsCancellationRequested) do + while !flag && (not cancellationToken.IsCancellationRequested) do let! _line = x.readLine () match _line with | Ok line -> @@ -204,11 +207,11 @@ type HttpReader(transport : TcpTransport, lineBuffer : byte array, pipe: Pipe, c } /// Read the post data from the stream, given the number of bytes that makes up the post data. - member (*inline*) x.readPostData (bytes : int) (select:ReadOnlyMemory -> int -> unit) : SocketOp = - let rec loop (n:int) : SocketOp = + member (*inline*) x.readPostData (bytes : int) (select:ReadOnlyMemory -> int -> unit) : Task = + let rec loop (n:int) : Task = task { if n = 0 then - return Result.Ok() + return () else let! result = x.getData() let bufferSequence = result.Buffer @@ -217,18 +220,22 @@ type HttpReader(transport : TcpTransport, lineBuffer : byte array, pipe: Pipe, c if segment.Length > n then select segment n pipe.Reader.AdvanceTo(bufferSequence.GetPosition(int64(n))) - return Result.Ok() + return () else select segment segment.Length pipe.Reader.AdvanceTo(bufferSequence.GetPosition(int64(segment.Length))) return! loop (n - segment.Length) else - return Result.Ok() + return () } loop bytes + member this.isDirty = dirty + member this.readLoop() = task{ + dirty <- true let reading = ref true + running <- true let result = ref (Ok()) while running && !reading && not(cancellationToken.IsCancellationRequested) do let! a = this.readMoreData() @@ -237,6 +244,7 @@ type HttpReader(transport : TcpTransport, lineBuffer : byte array, pipe: Pipe, c | a -> reading := false result := a + this.stop() return result } diff --git a/src/Suave/Sockets/TcpTransport.fs b/src/Suave/Sockets/TcpTransport.fs index ada6d387..f889fb44 100644 --- a/src/Suave/Sockets/TcpTransport.fs +++ b/src/Suave/Sockets/TcpTransport.fs @@ -4,6 +4,7 @@ open System.Net open System.Net.Sockets open System.Threading open Suave +open System [] type TcpTransport(listenSocket : Socket, cancellationToken:CancellationToken) = @@ -12,13 +13,13 @@ type TcpTransport(listenSocket : Socket, cancellationToken:CancellationToken) = val mutable acceptSocket : Socket let shutdownSocket (acceptSocket:Socket) = - try - if acceptSocket <> null then - try - acceptSocket.Shutdown(SocketShutdown.Both) - with _ -> + // do not like this if here + if acceptSocket <> null then + try + acceptSocket.Shutdown(SocketShutdown.Both) + //Console.WriteLine("Socket shutdown smoothly") + finally acceptSocket.Dispose () - with _ -> () let remoteBinding (socket : Socket) : SocketBinding = let rep = socket.RemoteEndPoint :?> IPEndPoint @@ -32,16 +33,18 @@ type TcpTransport(listenSocket : Socket, cancellationToken:CancellationToken) = } member this.read (buf : ByteSegment) = - task{ - let! result = this.acceptSocket.ReceiveAsync(buf,cancellationToken) - return Ok(result) - } + this.acceptSocket.ReceiveAsync(buf,cancellationToken) + //task{ + //let! result = this.acceptSocket.ReceiveAsync(buf,cancellationToken) + //return Ok(result) + //} member this.write (buf : ByteSegment) = - task{ - let! result = this.acceptSocket.SendAsync(buf,cancellationToken) - return Ok() - } + this.acceptSocket.SendAsync(buf,cancellationToken) + //task{ + //let! result = this.acceptSocket.SendAsync(buf,cancellationToken) + //return Ok() + //} member this.shutdown() = shutdownSocket (this.acceptSocket) diff --git a/src/Suave/State.fs b/src/Suave/State.fs index 84be1f21..58287556 100644 --- a/src/Suave/State.fs +++ b/src/Suave/State.fs @@ -1,8 +1,6 @@ module Suave.State open Suave.Cookie -open Suave.Logging -open Suave.Logging.Message /// A session store is a reader and a writer function pair keyed on strings. type StateStore = @@ -25,13 +23,6 @@ module CookieStateStore = let write relativeExpiry (cookieName : string) (value : 'T) = context (fun ctx -> - let event message = - eventX message - >> setFieldValue "cookieName" cookieName - >> setSingleName "Suave.State.CookieStateStore.write" - - let debug eventFactory = - ctx.runtime.logger.debug eventFactory let cookieState = { serverKey = ctx.runtime.serverKey @@ -40,11 +31,8 @@ module CookieStateStore = relativeExpiry = relativeExpiry secure = false } - debug (event "Writing to {cookieName}") updateCookies cookieState (function | None -> - debug (event "In fPlainText, no existing cookie") - Map.empty |> Map.add cookieName (box value) |> ctx.runtime.cookieSerialiser.serialise @@ -52,13 +40,11 @@ module CookieStateStore = | Some data -> try let m = ctx.runtime.cookieSerialiser.deserialise data - debug (event "In fPlainText, has existing {cookie}" >> setFieldValue "cookie" m) m |> Map.add cookieName (box value) |> ctx.runtime.cookieSerialiser.serialise with ex -> - debug (event "In fPlainText, couldn't deserialize cookie data") Map.empty |> Map.add cookieName (box value) |> ctx.runtime.cookieSerialiser.serialise)) @@ -66,13 +52,6 @@ module CookieStateStore = let remove relativeExpiry (cookieName : string) = context (fun ctx -> - let event message = - eventX message - >> setFieldValue "cookieName" cookieName - >> setSingleName "Suave.State.CookieStateStore.remove" - - let debug eventFactory = - ctx.runtime.logger.debug eventFactory let cookieState = { serverKey = ctx.runtime.serverKey @@ -81,11 +60,8 @@ module CookieStateStore = relativeExpiry = relativeExpiry secure = false } - debug (event "Removing {cookieName}") updateCookies cookieState (function | None -> - debug (event "In fPlainText, no existing cookie") - Map.empty |> ctx.runtime.cookieSerialiser.serialise @@ -95,22 +71,16 @@ module CookieStateStore = ctx.runtime.cookieSerialiser.deserialise data with _ -> - debug (event "In fPlainText, couldn't deserialize cookie data") - Map.empty // Although not strictly needed, this allows us to avoid unnecessarily // re-serialising the same data if the key is not present. if m |> Map.containsKey cookieName then - debug (event "In fPlainText, has existing {cookie}" >> setFieldValue "cookie" m) - try m |> Map.remove cookieName // Remove the key if we have gotten this far. |> ctx.runtime.cookieSerialiser.serialise with _ -> - debug (event "In fPlainText, couldn't serialize cookie data") - // Return the original data on failure. data else @@ -119,9 +89,6 @@ module CookieStateStore = let stateful relativeExpiry secure : WebPart = context (fun ctx -> - ctx.runtime.logger.debug ( - eventX "Ensuring cookie state" - >> setSingleName "Suave.State.CookieStateStore.stateful") let cipherTextCorrupt = (fun s -> s.ToString()) >> RequestErrors.BAD_REQUEST >> Choice2Of2 diff --git a/src/Suave/Stream.fs b/src/Suave/Stream.fs index c35e309a..da12406a 100644 --- a/src/Suave/Stream.fs +++ b/src/Suave/Stream.fs @@ -3,7 +3,6 @@ module Suave.Stream open System.IO open Suave open Suave.Sockets -open Suave.Sockets.Control /// Send a stream back in the response with 200 status. /// A new stream will be created for every request and it will be disposed after the request completes. @@ -12,8 +11,8 @@ open Suave.Sockets.Control let okStream (makeStream : Async) : WebPart = fun ctx -> let write (conn: Connection, _) = - socket { - use! stream = SocketOp.ofAsync makeStream + task { + use! stream = makeStream do! conn.asyncWriteLn $"Content-Length: %i{stream.Length}\r\n" do! conn.flush() @@ -39,8 +38,8 @@ let okStream (makeStream : Async) : WebPart = let okStreamChunked (makeStream : Async) : WebPart = fun ctx -> let write (conn:Connection, _) = - socket { - use! stream = SocketOp.ofAsync makeStream + task { + use! stream = makeStream do! conn.asyncWriteLn "" do! conn.flush() diff --git a/src/Suave/Suave.fsproj b/src/Suave/Suave.fsproj index 81485d79..afcaecf2 100644 --- a/src/Suave/Suave.fsproj +++ b/src/Suave/Suave.fsproj @@ -8,7 +8,6 @@ - diff --git a/src/Suave/SuaveConfig.fs b/src/Suave/SuaveConfig.fs index a3df6595..7068d675 100644 --- a/src/Suave/SuaveConfig.fs +++ b/src/Suave/SuaveConfig.fs @@ -1,6 +1,5 @@ namespace Suave -open Suave.Logging open System /// The core configuration of suave. See also Suave.Web.default_config which @@ -41,14 +40,6 @@ type SuaveConfig = /// Folder for temporary compressed files compressedFilesFolder : string option - /// Suave's logger. You can override the default instance if you wish to - /// ship your logs, e.g. using https://www.nuget.org/packages/Logary.Adapters.Suave/ - /// Also, this logger will be configured by default for Suave unless you - /// explicitly use `Suave.Logging.Global.initialise` before starting the - /// web server (the first time – the second time, the static will already - /// have been initialised). - logger : Logger - /// The cookie serialiser to use for converting the data you save in cookies /// from your application into a byte array. cookieSerialiser : CookieSerialiser @@ -70,7 +61,6 @@ type SuaveConfig = member x.withMimeTypesMap(v) = { x with mimeTypesMap = v } member x.withHomeFolder(v) = { x with homeFolder = v } member x.withCompressedFilesFolder(v) = { x with compressedFilesFolder = v } - member x.withLogger(v) = { x with logger = v } member x.withHiddenHeader(v) = { x with hideHeader = v } member x.withMaxContentLength(v) = { x with maxContentLength = v } @@ -87,7 +77,6 @@ module SuaveConfig = config.mimeTypesMap contentFolder compressionFolder - config.logger config.cookieSerialiser config.hideHeader config.maxContentLength diff --git a/src/Suave/Tcp.fs b/src/Suave/Tcp.fs index c6320db0..84233c3b 100644 --- a/src/Suave/Tcp.fs +++ b/src/Suave/Tcp.fs @@ -4,14 +4,10 @@ open System open System.Threading open System.Net open System.Net.Sockets -open Suave.Logging -open Suave.Logging.Message open Suave.Sockets open Suave.Utils open System.Threading.Tasks -let private logger = Log.create "Suave.Tcp" - /// The max backlog of number of requests [] let MaxBacklog = Int32.MaxValue @@ -33,11 +29,9 @@ type StartedData = /// Stop the TCP listener server let stopTcp reason (socket : Socket) = try - logger.debug (eventX "Stopping TCP server {because}" >> setFieldValue "because" reason) socket.Dispose() - logger.debug (eventX "Stopped TCP server") with ex -> - logger.debug (eventX "Failure stopping TCP server" >> addExn ex) + () open System.IO.Pipelines open System.Runtime.InteropServices @@ -64,7 +58,7 @@ let createConnection listenSocket cancellationToken bufferSize = let createConnectionFacade connectionPool listenSocket (runtime: HttpRuntime) cancellationToken bufferSize webpart = let connection = createConnection listenSocket cancellationToken bufferSize - let facade = new ConnectionFacade(connection, runtime, logger, connectionPool,cancellationToken,webpart) + let facade = new ConnectionFacade(connection, runtime, connectionPool,cancellationToken,webpart) facade let createPools listenSocket maxOps runtime cancellationToken bufferSize (webpart:WebPart) = @@ -124,10 +118,6 @@ let enableRebinding (listenSocket: Socket) = else if RuntimeInformation.IsOSPlatform(OSPlatform.OSX) then setsockoptStatus <- setsockopt(listenSocket.Handle, SOL_SOCKET_OSX, SO_REUSEADDR_OSX, NativePtr.toNativeInt &&optionValue, uint32(sizeof)) - if setsockoptStatus <> 0 then - logger.warn(eventX "Setting SO_REUSEADDR failed with errno '{errno}'." >> setFieldValue "errno" (Marshal.GetLastWin32Error())) - - let runServer maxConcurrentOps bufferSize (binding: SocketBinding) (runtime:HttpRuntime) (cancellationToken: CancellationToken) (webpart: WebPart) startData (acceptingConnections: AsyncResultCell) = Task.Run(fun () -> @@ -142,7 +132,6 @@ let runServer maxConcurrentOps bufferSize (binding: SocketBinding) (runtime:Http aFewTimesDeterministic (fun () -> listenSocket.Bind binding.endpoint) listenSocket.Listen MaxBacklog - // Get the actual assigned port from listeSocket let _binding = { startData.binding with port = uint16((listenSocket.LocalEndPoint :?> IPEndPoint).Port) } let startData = @@ -150,26 +139,27 @@ let runServer maxConcurrentOps bufferSize (binding: SocketBinding) (runtime:Http acceptingConnections.complete startData |> ignore - logger.info ( - eventX "Smooth! Suave listener started in {startedListeningMilliseconds:#.###}ms with binding {ipAddress}:{port}" - >> setFieldValue "startedListeningMilliseconds" (startData.GetStartedListeningElapsedMilliseconds()) - // .Address can throw exceptions, just log its string representation - >> setFieldValue "ipAddress" (startData.binding.ip.ToString()) - >> setFieldValue "port" startData.binding.port - >> setSingleName "Suave.Tcp.runServer") + let startedListeningMilliseconds = (startData.GetStartedListeningElapsedMilliseconds()) + let ipAddress = (startData.binding.ip.ToString()) + let port = startData.binding.port + + Console.WriteLine($"Smooth! Suave listener started in {startedListeningMilliseconds} ms with binding {ipAddress}:{port}") - // we could have an old style imperative loop let remoteBinding (socket : Socket) = let rep = socket.RemoteEndPoint :?> IPEndPoint { ip = rep.Address; port = uint16 rep.Port } while not(cancellationToken.IsCancellationRequested) do let connection : ConnectionFacade = connectionPool.Pop() + let continuation (vt: Task) = connection.Connection.transport.acceptSocket <- vt.Result ignore(Task.Factory.StartNew(fun () -> connection.accept(remoteBinding vt.Result),cancellationToken)) - logger.verbose (eventX "Waiting for accept") + let task = listenSocket.AcceptAsync(cancellationToken) + + // kestrel uses here ThreadPool.UnsafeQueueUserWorkItem(kestrelConnection, preferLocal: false); + if task.IsCompleted then connection.Connection.transport.acceptSocket <- task.Result ignore(Task.Factory.StartNew(fun () -> connection.accept(remoteBinding task.Result),cancellationToken)) @@ -185,8 +175,6 @@ let runServer maxConcurrentOps bufferSize (binding: SocketBinding) (runtime:Http stopTcp "The operation was canceled" listenSocket | ex -> stopTcp "runtime exception" listenSocket - logger.fatal (eventX "TCP server failed" >> addExn ex) - //raise ex ) /// Start a new TCP server with a specific IP, Port and with a serve_client worker diff --git a/src/Suave/Utils/Logging.fs b/src/Suave/Utils/Logging.fs deleted file mode 100644 index 518c942a..00000000 --- a/src/Suave/Utils/Logging.fs +++ /dev/null @@ -1,963 +0,0 @@ -/// The logging namespace, which contains the logging abstraction for this -/// library. -namespace Suave.Logging - -open System -open System.Runtime.CompilerServices - -/// The log level denotes how 'important' the gauge or event message is. -[] -type LogLevel = - /// The log message is not that important; can be used for intricate debugging. - | Verbose - /// The log message is at a default level, debug level. Useful for shipping to - /// infrastructure that further processes it, but not so useful for human - /// inspection in its raw format, except during development. - | Debug - /// The log message is informational; e.g. the service started, stopped or - /// some important business event occurred. - | Info - /// The log message is a warning; e.g. there was an unhandled exception or - /// an even occurred which was unexpected. Sometimes human corrective action - /// is needed. - | Warn - /// The log message is at an error level, meaning an unhandled exception - /// occurred at a location where it is deemed important to keeping the service - /// running. A human should take corrective action. - | Error - /// The log message denotes a fatal error which cannot be recovered from. The - /// service should be shut down. Human corrective action is needed. - | Fatal - - /// Converts the LogLevel to a string - override x.ToString () = - match x with - | Verbose -> "verbose" - | Debug -> "debug" - | Info -> "info" - | Warn -> "warn" - | Error -> "error" - | Fatal -> "fatal" - - /// Converts the string passed to a Loglevel. - static member ofString (str : string) = - if str = null then invalidArg "str" "may not be null" - match str.ToLowerInvariant() with - | "verbose" -> Verbose - | "debug" -> Debug - | "info" -> Info - | "warn" -> Warn - | "error" -> Error - | "fatal" -> Fatal - | _ -> Info - - /// Turn the LogLevel into an integer - member x.toInt () = - (function - | Verbose -> 1 - | Debug -> 2 - | Info -> 3 - | Warn -> 4 - | Error -> 5 - | Fatal -> 6) x - - /// Turn an integer into a LogLevel - static member ofInt i = - (function - | 1 -> Verbose - | 2 -> Debug - | 3 -> Info - | 4 -> Warn - | 5 -> Error - | 6 -> Fatal - | _ as i -> failwithf "LogLevel matching integer %i is not available" i) i - - interface IComparable with - member x.CompareTo other = - compare (x.toInt()) (other.toInt()) - - static member op_LessThan (a, b) = - (a :> IComparable).CompareTo(b) < 0 - static member op_LessThanOrEqual (a, b) = - (a :> IComparable).CompareTo(b) <= 0 - static member op_GreaterThan (a, b) = - (a :> IComparable).CompareTo(b) > 0 - static member op_GreaterThanOrEqual (a, b) = - (a :> IComparable).CompareTo(b) >= 0 - - override x.GetHashCode () = - x.toInt () - - interface IComparable with - member x.CompareTo other = - match other with - | null -> - 1 - | :? LogLevel as tother -> - (x :> IComparable).CompareTo tother - | _ -> - failwithf "invalid comparison %A to %A" x other - - interface IEquatable with - member x.Equals other = - x.toInt() = other.toInt() - - override x.Equals other = - (x :> IComparable).CompareTo other = 0 - -/// Represents a logged value; either a Gauge or an Event. -type PointValue = - /// An event is what it sounds like; something occurred and needs to be - /// logged. Its field is named 'template' because it should not be interpolated - /// with values; instead these values should be put in the 'fields' field of - /// the Message. - | Event of template:string - /// This is as value for a metric, with a unit attached. The unit can be - /// something like Seconds or Hz. - | Gauge of value:int64 * units:string - -/// The # of nanoseconds after 1970-01-01 00:00:00. -type EpochNanoSeconds = int64 - -/// Helper functions for transforming DateTime to timestamps in unix epoch. -module DateTime = - - /// Get the Logary timestamp off the DateTime. - let timestamp (dt : DateTime) : EpochNanoSeconds = - (dt.Ticks - DateTime(1970, 1, 1, 0, 0, 0, DateTimeKind.Utc).Ticks) - * 100L - - /// Get the DateTimeOffset ticks off from the EpochNanoSeconds. - let ticksUTC (epoch : EpochNanoSeconds) : int64 = - epoch / 100L - + DateTime(1970, 1, 1, 0, 0, 0, DateTimeKind.Utc).Ticks - -/// Helper functions for transforming DateTimeOffset to timestamps in unix epoch. -module DateTimeOffset = - - /// Get the Logary timestamp off the DateTimeOffset. - let timestamp (dt : DateTimeOffset) : EpochNanoSeconds = - (dt.Ticks - DateTimeOffset(1970, 1, 1, 0, 0, 0, TimeSpan.Zero).Ticks) - * 100L - - /// Get the DateTimeOffset ticks from EpochNanoSeconds - let ticksUTC (epoch : EpochNanoSeconds) : int64 = - epoch / 100L - + DateTimeOffset(1970, 1, 1, 0, 0, 0, TimeSpan.Zero).Ticks - -/// This is record that is logged. It's capable of representing both metrics -/// (gauges) and events. See https://github.com/logary/logary for details. -type Message = - { /// The 'path' or 'name' of this data point. Do not confuse template in - /// (Event template) = message.value - name : string[] - /// The main value for this metric or event. Either a Gauge or an Event. (A - /// discriminated union type) - value : PointValue - /// The structured-logging data. - fields : Map - /// When? nanoseconds since UNIX epoch. - timestamp : EpochNanoSeconds - /// How important? See the docs on the LogLevel type for details. - level : LogLevel } - - /// Gets the ticks for UTC since 0001-01-01 00:00:00 for this message. You - /// can pass this value into a DateTimeOffset c'tor - member x.utcTicks = - DateTimeOffset.ticksUTC x.timestamp - - /// If you're looking for how to transform the Message's fields, then use the - /// module methods rather than instance methods, since you'll be creating new - /// values rather than changing an existing value. - member x.README = - () - -/// The logger is the interface for calling code to use for logging. Its -/// different functions have different semantics - read the docs for each -/// method to choose the right one for your use-case. -type Logger = - /// Gets the name of the logger instance. - abstract member name : string[] - /// Logs with the specified log level with backpressure via the logging - /// library's buffers *and* ACK/flush to the underlying message targets. - /// - /// Calls to this function will block the caller only while executing the - /// callback (if the level is active). - /// - /// The returned async value will yield when the message has been flushed to - /// the underlying message targets. - /// - /// You need to start the (cold) async value for the logging to happen. - /// - /// You should not do blocking/heavy operations in the callback. - abstract member logWithAck : LogLevel -> (LogLevel -> Message) -> Async - - /// Logs with the specified log level with backpressure via the logging - /// library's buffers. - /// - /// Calls to this function will block the caller only while executing the - /// callback (if the level is active). - /// - /// The returned async value will yield when the message has been added to - /// the buffers of the logging library. - /// - /// You need to start the (cold) async value for the logging to happen. - /// - /// You should not do blocking/heavy operations in the callback. - abstract member log : LogLevel -> (LogLevel -> Message) -> unit - -/// Syntactic sugar on top of Logger for F# libraries. -[] -module LoggerEx = - open System.Diagnostics - - type Logger with - - [] - member x.verbose (messageFactory : LogLevel -> Message) : unit = - x.log Verbose messageFactory - - [] - member x.debug (messageFactory : LogLevel -> Message) : unit = - x.log LogLevel.Debug messageFactory - - member x.info (messageFactory : LogLevel -> Message) : unit = - x.log Info messageFactory - - member x.warn (messageFactory : LogLevel -> Message) : unit = - x.log Warn messageFactory - - member x.error (messageFactory : LogLevel -> Message) : unit = - x.log Error messageFactory - - member x.fatal (messageFactory : LogLevel -> Message) : unit = - x.log Fatal messageFactory - - member x.logSimple message : unit = - x.log message.level (fun _ -> message) - -type LoggingConfig = - { /// The `timestamp` function should preferably be monotonic and not 'jumpy' - /// or take much time to call. - timestamp : unit -> int64 - /// The `getLogger` function returns a logger that directly can be logged to. - getLogger : string[] -> Logger - /// When composing apps from the outside-in (rather than having a unified - /// framework with static/global config) with libraries (again, rather than - /// a unified framework) like is best-practice, there's not necessarily a - /// way to coordinate around the STDOUT and STDERR streams between - /// different libraries running things on different threads. Use Logary's - /// adapter to replace this semaphore with a global semaphore. - consoleSemaphore : obj } - -module Literate = - /// The output tokens, which can be potentially coloured. - type LiterateToken = - | Text | Subtext - | Punctuation - | LevelVerbose | LevelDebug | LevelInfo | LevelWarning | LevelError | LevelFatal - | KeywordSymbol | NumericSymbol | StringSymbol | OtherSymbol | NameSymbol - | MissingTemplateField - - type LiterateOptions = - { formatProvider : IFormatProvider - theme : LiterateToken -> ConsoleColor - getLogLevelText : LogLevel -> string - printTemplateFieldNames : bool } - - static member create ?formatProvider = - // note: literate is meant for human consumption, and so the default - // format provider of 'Current' is appropriate here. The reader expects - // to see the dates, numbers, currency, etc formatted in the local culture - { formatProvider = defaultArg formatProvider Globalization.CultureInfo.CurrentCulture - getLogLevelText = function - | Debug -> "DBG" - | Error -> "ERR" - | Fatal -> "FTL" - | Info -> "INF" - | Verbose -> "VRB" - | Warn -> "WRN" - theme = function - | Text -> ConsoleColor.White - | Subtext -> ConsoleColor.Gray - | Punctuation -> ConsoleColor.DarkGray - | LevelVerbose -> ConsoleColor.Gray - | LevelDebug -> ConsoleColor.Gray - | LevelInfo -> ConsoleColor.White - | LevelWarning -> ConsoleColor.Yellow - | LevelError -> ConsoleColor.Red - | LevelFatal -> ConsoleColor.Red - | KeywordSymbol -> ConsoleColor.Blue - | NumericSymbol -> ConsoleColor.Magenta - | StringSymbol -> ConsoleColor.Cyan - | OtherSymbol -> ConsoleColor.Green - | NameSymbol -> ConsoleColor.Gray - | MissingTemplateField -> ConsoleColor.Red - printTemplateFieldNames = false } - - static member createInvariant() = - LiterateOptions.create Globalization.CultureInfo.InvariantCulture - -/// Module that contains the 'known' keys of the Maps in the Message type's -/// fields/runtime data. -module Literals = - - /// What version of the Facade is this. This is a major version that allows the Facade - /// adapter to choose how it handles the API. - let FacadeVersion = 2u - - /// What language this Facade has. This controls things like naming standards. - let FacadeLanguage = "F#" - - [] - let FieldExnKey = "exn" - - [] - let FieldErrorsKey = "errors" - -module internal FsMtParser = - open System.Text - - type Property(name : string, format : string) = - static let emptyInstance = Property("", null) - static member empty = emptyInstance - member x.name = name - member x.format = format - member internal x.AppendPropertyString(sb : StringBuilder, ?replacementName) = - sb.Append("{") - .Append(defaultArg replacementName name) - .Append(match x.format with null | "" -> "" | _ -> ":" + x.format) - .Append("}") - override x.ToString() = x.AppendPropertyString(StringBuilder()).ToString() - - module internal ParserBits = - - let inline isNull o = - match o with - | null -> true - | _ -> false - - let inline isLetterOrDigit c = System.Char.IsLetterOrDigit c - let inline isValidInPropName c = c = '_' || System.Char.IsLetterOrDigit c - let inline isValidInFormat c = c <> '}' && (c = ' ' || isLetterOrDigit c || System.Char.IsPunctuation c) - let inline isValidCharInPropTag c = c = ':' || isValidInPropName c || isValidInFormat c - - [] - type Range(startIndex : int, endIndex : int) = - member inline x.start = startIndex - member inline x.``end`` = endIndex - member inline x.length = (endIndex - startIndex) + 1 - member inline x.getSubstring (s : string) = s.Substring(startIndex, x.length) - member inline x.isEmpty = startIndex = -1 && endIndex = -1 - static member inline substring (s : string, startIndex, endIndex) = s.Substring(startIndex, (endIndex - startIndex) + 1) - static member inline empty = Range(-1, -1) - - let inline tryGetFirstCharInRange predicate (s : string) (range : Range) = - let rec go i = - if i > range.``end`` then -1 - else if not (predicate s.[i]) then go (i+1) else i - go range.start - - let inline tryGetFirstChar predicate (s : string) first = - tryGetFirstCharInRange predicate s (Range(first, s.Length - 1)) - - let inline hasAnyInRange predicate (s : string) (range : Range) = - match tryGetFirstChar (predicate) s range.start with - | -1 -> - false - | i -> - i <= range.``end`` - - let inline hasAny predicate (s : string) = hasAnyInRange predicate s (Range(0, s.Length - 1)) - let inline indexOfInRange s range c = tryGetFirstCharInRange ((=) c) s range - - let inline tryGetPropInRange (template : string) (within : Range) : Property = - // Attempts to validate and parse a property token within the specified range inside - // the template string. If the property insides contains any invalid characters, - // then the `Property.Empty' instance is returned (hence the name 'try') - let nameRange, formatRange = - match indexOfInRange template within ':' with - | -1 -> - within, Range.empty // no format - | formatIndex -> - Range(within.start, formatIndex-1), Range(formatIndex+1, within.``end``) // has format part - let propertyName = nameRange.getSubstring template - if propertyName = "" || (hasAny (not<unit) : int = - // Finds the next text token (starting from the 'startAt' index) and returns the next character - // index within the template string. If the end of the template string is reached, or the start - // of a property token is found (i.e. a single { character), then the 'consumed' text is passed - // to the 'foundText' method, and index of the next character is returned. - let mutable escapedBuilder = Unchecked.defaultof // don't create one until it's needed - let inline append (ch : char) = if not (isNull escapedBuilder) then escapedBuilder.Append(ch) |> ignore - let inline createStringBuilderAndPopulate i = - if isNull escapedBuilder then - escapedBuilder <- StringBuilder() // found escaped open-brace, take the slow path - for chIndex = startAt to i-1 do append template.[chIndex] // append all existing chars - let rec go i = - if i >= template.Length then - template.Length // bail out at the end of the string - else - let ch = template.[i] - match ch with - | '{' -> - if (i+1) < template.Length && template.[i+1] = '{' then - createStringBuilderAndPopulate i; append ch; go (i+2) - else i // found an open brace (potentially a property), so bail out - | '}' when (i+1) < template.Length && template.[i+1] = '}' -> - createStringBuilderAndPopulate i; append ch; go (i+2) - | _ -> - append ch; go (i+1) - - let nextIndex = go startAt - if (nextIndex > startAt) then // if we 'consumed' any characters, signal that we 'foundText' - if isNull escapedBuilder then - foundText (Range.substring(template, startAt, nextIndex - 1)) - else - foundText (escapedBuilder.ToString()) - nextIndex - - let findPropOrText (start : int) (template : string) - (foundText : string -> unit) - (foundProp : Property -> unit) : int = - // Attempts to find the indices of the next property in the template - // string (starting from the 'start' index). Once the start and end of - // the property token is known, it will be further validated (by the - // tryGetPropInRange method). If the range turns out to be invalid, it's - // not a property token, and we return it as text instead. We also need - // to handle some special case here: if the end of the string is reached, - // without finding the close brace (we just signal 'foundText' in that case). - let nextInvalidCharIndex = - match tryGetFirstChar (not << isValidCharInPropTag) template (start+1) with - | -1 -> - template.Length - | idx -> - idx - - if nextInvalidCharIndex = template.Length || template.[nextInvalidCharIndex] <> '}' then - foundText (Range.substring(template, start, (nextInvalidCharIndex - 1))) - nextInvalidCharIndex - else - let nextIndex = nextInvalidCharIndex + 1 - let propInsidesRng = Range(start + 1, nextIndex - 2) - match tryGetPropInRange template propInsidesRng with - | prop when not (obj.ReferenceEquals(prop, Property.empty)) -> - foundProp prop - | _ -> - foundText (Range.substring(template, start, (nextIndex - 1))) - nextIndex - - /// Parses template strings such as "Hello, {PropertyWithFormat:##.##}" - /// and calls the 'foundTextF' or 'foundPropF' functions as the text or - /// property tokens are encountered. - let parseParts (template : string) foundTextF foundPropF = - let tlen = template.Length - let rec go start = - if start >= tlen then () else - match ParserBits.findNextNonPropText start template foundTextF with - | next when next <> start -> - go next - | _ -> - go (ParserBits.findPropOrText start template foundTextF foundPropF) - go 0 - -/// Internal module for formatting text for printing to the console. -module internal Formatting = - open System.Text - open Literals - open Literate - - let literateFormatValue (options : LiterateOptions) (fields : Map) = function - | Event template -> - let themedParts = ResizeArray() - let matchedFields = ResizeArray() - let foundText (text: string) = themedParts.Add (text, Text) - let foundProp (prop: FsMtParser.Property) = - match Map.tryFind prop.name fields with - | Some propValue -> - // render using string.Format, so the formatting is applied - let stringFormatTemplate = prop.AppendPropertyString(StringBuilder(), "0").ToString() - let fieldAsText = String.Format (options.formatProvider, stringFormatTemplate, [| propValue |]) - // find the right theme colour based on data type - let valueColour = - match propValue with - | :? bool -> - KeywordSymbol - | :? int16 | :? int32 | :? int64 | :? decimal | :? float | :? double -> - NumericSymbol - | :? string | :? char -> - StringSymbol - | _ -> - OtherSymbol - if options.printTemplateFieldNames then - themedParts.Add ("["+prop.name+"] ", Subtext) - matchedFields.Add prop.name - themedParts.Add (fieldAsText, valueColour) - - | None -> - themedParts.Add (prop.ToString(), MissingTemplateField) - - FsMtParser.parseParts template foundText foundProp - Set.ofSeq matchedFields, List.ofSeq themedParts - - | Gauge (value, units) -> - Set.empty, [ value.ToString(), NumericSymbol - units, KeywordSymbol ] - - let formatValue (fields : Map) (pv : PointValue) = - let matchedFields, themedParts = - literateFormatValue (LiterateOptions.createInvariant()) fields pv - matchedFields, System.String.Concat(themedParts |> List.map fst) - - let literateExceptionColouriser (options : LiterateOptions) (ex : exn) = - let stackFrameLinePrefix = " at" // 3 spaces - let monoStackFrameLinePrefix = " at" // 2 spaces - use exnLines = new System.IO.StringReader(ex.ToString()) - let rec go lines = - match exnLines.ReadLine() with - | null -> - List.rev lines // finished reading - | line -> - if line.StartsWith(stackFrameLinePrefix) || line.StartsWith(monoStackFrameLinePrefix) then - // subtext - go ((line, Subtext) :: (Environment.NewLine, Text) :: lines) - else - // regular text - go ((line, Text) :: (Environment.NewLine, Text) :: lines) - go [] - - let literateColouriseExceptions (context : LiterateOptions) message = - let exnExceptionParts = - match message.fields.TryFind FieldExnKey with - | Some (:? Exception as ex) -> - literateExceptionColouriser context ex - | _ -> - [] // there is no spoon - let errorsExceptionParts = - match message.fields.TryFind FieldErrorsKey with - | Some (:? List as exnListAsObjList) -> - exnListAsObjList |> List.collect (function - | :? exn as ex -> - literateExceptionColouriser context ex - | _ -> - []) - | _ -> - [] - - exnExceptionParts @ errorsExceptionParts - - let getLogLevelToken = function - | Verbose -> LevelVerbose - | Debug -> LevelDebug - | Info -> LevelInfo - | Warn -> LevelWarning - | Error -> LevelError - | Fatal -> LevelFatal - - /// Split a structured message up into theme-able parts (tokens), allowing the - /// final output to display to a user with colours to enhance readability. - let literateDefaultTokeniser (options : LiterateOptions) (message : Message) : (string * LiterateToken) list = - let formatLocalTime (utcTicks : int64) = - DateTimeOffset(utcTicks, TimeSpan.Zero).LocalDateTime.ToString("HH:mm:ss", options.formatProvider), - Subtext - - let themedMessageParts = - message.value |> literateFormatValue options message.fields |> snd - - let themedExceptionParts = literateColouriseExceptions options message - - [ "[", Punctuation - formatLocalTime message.utcTicks - " ", Subtext - options.getLogLevelText message.level, getLogLevelToken message.level - "] ", Punctuation ] - @ themedMessageParts - @ themedExceptionParts - - let literateDefaultColourWriter sem (parts : (string * ConsoleColor) list) = - lock sem <| fun _ -> - let originalColour = Console.ForegroundColor - let mutable currentColour = originalColour - parts |> List.iter (fun (text, colour) -> - if currentColour <> colour then - Console.ForegroundColor <- colour - currentColour <- colour - Console.Write(text) - ) - if currentColour <> originalColour then - Console.ForegroundColor <- originalColour - - /// let the ISO8601 love flow - let defaultFormatter (message : Message) = - let app (x : obj) (sb : StringBuilder) = - sb.Append x |> ignore - - let formatLevel (level : LogLevel) = - "[" + Char.ToUpperInvariant(level.ToString().[0]).ToString() + "] " - - let formatInstant (utcTicks : int64) = - (DateTimeOffset(utcTicks, TimeSpan.Zero).ToString("o")) + ": " - - let formatName (name : string[]) = - " [" + String.concat "." name + "]" - - let formatExn (fields : Map) = - match fields |> Map.tryFind FieldExnKey with - | None -> - String.Empty - | Some ex -> - " exn:\n" + ex.ToString() - - let formatFields (ignored : Set) (fields : Map) = - if not (Map.isEmpty fields) then - fields - |> Seq.filter (fun (KeyValue (k, _)) -> not (ignored |> Set.contains k)) - |> Seq.map (fun (KeyValue (k, v)) -> "\n - " + k + ": " + v.ToString()) - |> String.concat "" - else - "" - - let matchedFields, valueString = - formatValue message.fields message.value - - // [I] 2014-04-05T12:34:56Z: Hello World! [my.sample.app] - formatLevel message.level + - formatInstant message.utcTicks + - valueString + - formatName message.name + - formatExn message.fields + - formatFields matchedFields message.fields - -/// Assists with controlling the output of the `LiterateConsoleTarget`. -module internal LiterateFormatting = - open Literate - type TokenisedPart = string * LiterateToken - type LiterateTokeniser = LiterateOptions -> Message -> TokenisedPart list - - type internal TemplateToken = TextToken of text:string | PropToken of name : string * format : string - let internal parseTemplate template = - let tokens = ResizeArray() - let foundText (text: string) = tokens.Add (TextToken text) - let foundProp (prop: FsMtParser.Property) = tokens.Add (PropToken (prop.name, prop.format)) - FsMtParser.parseParts template foundText foundProp - tokens :> seq - - [] - module OutputTemplateTokenisers = - - let tokeniseTimestamp format (options : LiterateOptions) (message : Message) = - let localDateTimeOffset = DateTimeOffset(message.utcTicks, TimeSpan.Zero).ToLocalTime() - let formattedTimestamp = localDateTimeOffset.ToString(format, options.formatProvider) - seq { yield formattedTimestamp, Subtext } - - let tokeniseTimestampUtc format (options : LiterateOptions) (message : Message) = - let utcDateTimeOffset = DateTimeOffset(message.utcTicks, TimeSpan.Zero) - let formattedTimestamp = utcDateTimeOffset.ToString(format, options.formatProvider) - seq { yield formattedTimestamp, Subtext } - - let tokeniseMissingField name format = - seq { - yield "{", Punctuation - yield name, MissingTemplateField - if not (String.IsNullOrEmpty format) then - yield ":", Punctuation - yield format, Subtext - yield "}", Punctuation } - - let tokeniseLogLevel (options : LiterateOptions) (message : Message) = - seq { yield options.getLogLevelText message.level, Formatting.getLogLevelToken message.level } - - let tokeniseSource (options : LiterateOptions) (message : Message) = - seq { yield (String.concat "." message.name), Subtext } - - let tokeniseNewline (options : LiterateOptions) (message : Message) = - seq { yield Environment.NewLine, Text } - - let tokeniseTab (options : LiterateOptions) (message : Message) = - seq { yield "\t", Text } - - /// Creates a `LiterateTokeniser` function which can be passed to the `LiterateConsoleTarget` - /// constructor in order to customise how each log message is rendered. The default template - /// would be: `[{timestampLocal:HH:mm:ss} {level}] {message}{newline}{exceptions}`. - /// Available template fields are: `timestamp`, `timestampUtc`, `level`, `source`, - /// `newline`, `tab`, `message`, `exceptions`. Any misspelled or otheriwese invalid property - /// names will be treated as `LiterateToken.MissingTemplateField`. - let tokeniserForOutputTemplate template : LiterateTokeniser = - let tokens = parseTemplate template - fun options message -> - seq { - for token in tokens do - match token with - | TextToken text -> yield text, LiterateToken.Punctuation - | PropToken (name, format) -> - match name with - | "timestamp" -> yield! tokeniseTimestamp format options message - | "timestampUtc" -> yield! tokeniseTimestampUtc format options message - | "level" -> yield! tokeniseLogLevel options message - | "source" -> yield! tokeniseSource options message - | "newline" -> yield! tokeniseNewline options message - | "tab" -> yield! tokeniseTab options message - | "message" -> yield! Formatting.literateFormatValue options message.fields message.value |> snd - | "exceptions" -> yield! Formatting.literateColouriseExceptions options message - | _ -> yield! tokeniseMissingField name format - } - |> Seq.toList - -/// Logs a line in a format that is great for human consumption, -/// using console colours to enhance readability. -/// Sample: [10:30:49 INF] User "AdamC" began the "checkout" process with 100 cart items -type LiterateConsoleTarget(name, minLevel, ?options, ?literateTokeniser, ?outputWriter, ?consoleSemaphore) = - let sem = defaultArg consoleSemaphore (obj()) - let options = defaultArg options (Literate.LiterateOptions.create()) - let tokenise = defaultArg literateTokeniser Formatting.literateDefaultTokeniser - let colourWriter = defaultArg outputWriter Formatting.literateDefaultColourWriter sem - - let colouriseThenNewLine message = - (tokenise options message) @ [Environment.NewLine, Literate.Text] - |> List.map (fun (s, t) -> - s, options.theme(t)) - - /// Creates the target with a custom output template. The default `outputTemplate` - /// is `[{timestampLocal:HH:mm:ss} {level}] {message}{exceptions}`. - /// Available template fields are: `timestamp`, `timestampUtc`, `level`, `source`, - /// `newline`, `tab`, `message`, `exceptions`. Any misspelled or otheriwese invalid property - /// names will be treated as `LiterateToken.MissingTemplateField`. - new (name, minLevel, outputTemplate, ?options, ?outputWriter, ?consoleSemaphore) = - let tokeniser = LiterateFormatting.tokeniserForOutputTemplate outputTemplate - LiterateConsoleTarget(name, minLevel, ?options=options, literateTokeniser=tokeniser, ?outputWriter=outputWriter, ?consoleSemaphore=consoleSemaphore) - - interface Logger with - member x.name = name - member x.logWithAck level msgFactory = - if level >= minLevel then - colourWriter (colouriseThenNewLine (msgFactory level)) - async.Return () - member x.log level msgFactory = - if level >= minLevel then - colourWriter (colouriseThenNewLine (msgFactory level)) - -type TextWriterTarget(name, minLevel, writer : System.IO.TextWriter, ?formatter) = - let formatter = defaultArg formatter Formatting.defaultFormatter - let log msg = writer.WriteLine(formatter msg) - - interface Logger with - member x.name = name - member x.log level messageFactory = - if level >= minLevel then log (messageFactory level) - - member x.logWithAck level messageFactory = - if level >= minLevel then log (messageFactory level) - async.Return () - -type OutputWindowTarget(name, minLevel, ?formatter) = - let formatter = defaultArg formatter Formatting.defaultFormatter - let log msg = System.Diagnostics.Debug.WriteLine(formatter msg) - - interface Logger with - member x.name = name - member x.log level messageFactory = - if level >= minLevel then log (messageFactory level) - - member x.logWithAck level messageFactory = - if level >= minLevel then log (messageFactory level) - async.Return () - -/// A logger to use for combining a number of other loggers -type CombiningTarget(name, otherLoggers : Logger list) = - interface Logger with - member x.name = name - member x.logWithAck level messageFactory = - otherLoggers - |> List.map (fun l -> l.logWithAck level messageFactory) - |> Async.Parallel - |> Async.Ignore // Async - - member x.log level messageFactory = - otherLoggers - |> List.map (fun l -> l.log level messageFactory) - |> ignore - -module Global = - /// This is the global semaphore for colourising the console output. Ensure - /// that the same semaphore is used across libraries by using the Logary - /// Facade Adapter in the final composing app/service. - let private consoleSemaphore = obj () - - /// The global default configuration, which logs to Console at Info level. - let defaultConfig = - { timestamp = fun () -> DateTimeOffset.timestamp DateTimeOffset.UtcNow - getLogger = fun name -> LiterateConsoleTarget(name, Info) :> Logger - consoleSemaphore = consoleSemaphore } - - let private config = - ref (defaultConfig, (* logical clock *) 1u) - - /// The flyweight just references the current configuration. If you want - /// multiple per-process logging setups, then don't use the static methods, - /// but instead pass a Logger instance around, setting the name field of the - /// Message value you pass into the logger. - type internal Flyweight(name : string[]) = - let updating = obj() - let mutable fwClock : uint32 = snd !config - let mutable logger : Logger = (fst !config).getLogger name - let rec withLogger action = - let cfg, cfgClock = !config // copy to local - let fwCurr = fwClock // copy to local - if cfgClock <> fwCurr then - lock updating <| fun _ -> - logger <- cfg.getLogger name - fwClock <- fwCurr + 1u - action logger - - let ensureName (m : Message) = - if Array.isEmpty m.name then { m with name = name } else m - - interface Logger with - member x.name = name - member x.log level msgFactory = - withLogger (fun logger -> logger.log level (msgFactory >> ensureName)) - - member x.logWithAck level msgFactory = - withLogger (fun logger -> logger.logWithAck level (msgFactory >> ensureName)) - - let internal getStaticLogger (name : string []) = - Flyweight name - - let timestamp () : EpochNanoSeconds = - (fst !config).timestamp () - - /// Returns the synchronisation object to use when printing to the console. - let internal semaphore () = - (fst !config).consoleSemaphore - - /// Run the passed function under the console semaphore lock. - let internal lockSem fn = - lock (semaphore ()) fn - - /// Call from the initialisation of your library. Initialises the - /// Suave.Logging globally/per process. - let initialise cfg = - config := (cfg, snd !config + 1u) - - let initialiseIfDefault cfg = - if snd !config = 1u then initialise cfg - -/// "Shortcut" for creating targets; useful at the top-level configuration point of -/// your library. -module Targets = - /// Create a new target. Prefer `Log.create` in your own libraries, or let the - /// composing app replace your target instance through your configuration. - /// - /// Will log to console (colourised) by default, and also to the output window - /// in your IDE if you specify a level below Info. - let create level name = - if level >= LogLevel.Info then - LiterateConsoleTarget(name, level, consoleSemaphore = Global.semaphore()) :> Logger - else - CombiningTarget( - name, - [ LiterateConsoleTarget(name, level, consoleSemaphore = Global.semaphore()) - OutputWindowTarget(name, level) ]) - :> Logger - -/// Module for acquiring static loggers (when you don't want or can't) -/// pass loggers as values. -module Log = - - /// Create a named logger. Full stop (.) acts as segment delimiter in the - /// hierachy of namespaces and loggers. - let create (name : string) = - if name = null then invalidArg "name" "name is null" - Global.getStaticLogger (name.Split([|'.'|], StringSplitOptions.RemoveEmptyEntries)) - :> Logger - - /// Create an hierarchically named logger - let createHiera (name : string[]) = - if name = null then invalidArg "name" "name is null" - if name.Length = 0 then invalidArg "name" "must have >0 segments" - Global.getStaticLogger name - :> Logger - -/// The Message module contains functions that can help callers compose messages. This -/// module is especially helpful to open to make calls into Logary's facade small. -[] -module Message = - open Literals - - /// Create a new event log message. - let event level template = - { name = [||] - value = Event template - fields = Map.empty - timestamp = Global.timestamp () - level = level } - - /// Create a new event log message – like `event` but with parameters flipped. - /// Useful to use with `Logger.log` with point-free style, to reduce the - /// noise. E.g. `logger.logVerbose (eventX "Returned {code}" >> setField "code" 24)` - let eventX template level = - event level template - - /// Create a new instantaneous value in a log message. - let gauge value units = - { name = [||] - value = Gauge (value, units) - fields = Map.empty - timestamp = Global.timestamp () - level = Debug } - - /// Sets the name/path of the log message. - let setName (name : string[]) (x : Message) = - { x with name = name } - - /// Sets the final portion o fthe name of the Message. - let setNameEnding (ending : string) (x : Message) = - if String.IsNullOrWhiteSpace ending then x else - let segs = ResizeArray<_>(x.name) - segs.Add ending - { x with name = segs.ToArray() } - - /// Sets the name as a single string; if this string contains dots, the string - /// will be split on these dots. - let setSingleName (name : string) (x : Message) = - if name = null then invalidArg "name" "may not be null" - - let name' = - name.Split([|'.'|], StringSplitOptions.RemoveEmptyEntries) - - x |> setName name' - - /// Sets the value of the field on the log message. - let setField (key : string) (value : obj) (x : Message) = - { x with fields = x.fields |> Map.add key value } - - /// Alias to `setField` - let setFieldValue = setField - - /// Sets the timestamp on the log message. - let setTimestamp (ts : EpochNanoSeconds) (x : Message) = - { x with timestamp = ts } - - /// Sets the level on the log message. - let setLevel (level : LogLevel) (x : Message) = - { x with level = level } - - /// Adds an exception to the Message, to the 'errors' field, inside a list. - let addExn ex (x : Message) = - let fields' = - match Map.tryFind FieldErrorsKey x.fields with - | None -> - x.fields |> Map.add FieldErrorsKey (box [ box ex ]) - - | Some errors -> - let arr : obj list = unbox errors - x.fields |> Map.add FieldErrorsKey (box (box ex :: arr)) - - { x with fields = fields' } diff --git a/src/Suave/Web.fs b/src/Suave/Web.fs index adcb927f..62a14070 100644 --- a/src/Suave/Web.fs +++ b/src/Suave/Web.fs @@ -11,13 +11,10 @@ module Web = open System.IO open System.Text open Suave.Utils - open Suave.Logging - open Suave.Logging.Message /// The default error handler returns a 500 Internal Error in response to /// thrown exceptions. let defaultErrorHandler (ex : Exception) msg (ctx : HttpContext) = - ctx.runtime.logger.error (eventX msg >> setSingleName "Suave.Web.defaultErrorHandler" >> addExn ex) if ctx.isLocalTrustProxy then Response.response HTTP_500 (Encoding.UTF8.GetBytes("

" + ex.Message + "


" + ex.ToString())) ctx else @@ -49,10 +46,6 @@ module Web = // spawn tcp listeners/web workers let toRuntime = SuaveConfig.toRuntime config homeFolder compressionFolder - // If noone has already touched the logging configuration, initialise it to - // that of Suave's configuration. - Global.initialiseIfDefault { Global.defaultConfig with getLogger = fun _ -> config.logger } - let startWebWorker runtime = let tcpServer = (tcpServerFactory :> TcpServerFactory).create(config.maxOps, config.bufferSize, runtime.matchedBinding.socketBinding,runtime,config.cancellationToken,webpart) @@ -86,7 +79,6 @@ module Web = mimeTypesMap = Writers.defaultMimeTypesMap homeFolder = None compressedFilesFolder = None - logger = Targets.create Info [| "Suave" |] cookieSerialiser = new BinaryFormatterSerialiser() hideHeader = false maxContentLength = 10000000 // 10 megabytes diff --git a/src/Suave/WebSocket.fs b/src/Suave/WebSocket.fs index 4e18e5a0..ab25ccd3 100644 --- a/src/Suave/WebSocket.fs +++ b/src/Suave/WebSocket.fs @@ -7,8 +7,6 @@ module WebSocket = open Suave.Operators open Suave.Utils open Suave.Utils.AsyncExtensions - open Suave.Logging - open Suave.Logging.Message open System open System.Security.Cryptography @@ -111,10 +109,11 @@ module WebSocket = let internal bytesToNetworkOrder (bytes : byte[]) = if BitConverter.IsLittleEndian then bytes |> Array.rev else bytes - let writeFrame (connection: Connection) (f: Frame) = socket { - do! connection.transport.write (Memory([| f.OpcodeByte |], 0, 1)) - do! connection.transport.write (Memory(f.EncodedLength, 0, f.EncodedLength.Length)) - do! connection.transport.write f.Data + let writeFrame (connection: Connection) (f: Frame) = task { + let! _ = connection.transport.write (Memory([| f.OpcodeByte |], 0, 1)) + let! _ = connection.transport.write (Memory(f.EncodedLength, 0, f.EncodedLength.Length)) + let! _ = connection.transport.write f.Data + return Ok() } let internal frame (opcode : Opcode) (data : ByteSegment) (fin : bool) = @@ -136,7 +135,7 @@ module WebSocket = { Frame.OpcodeByte = firstByte; EncodedLength = encodedLength; Data = data } let readBytes (connection : Connection) (n : int) = - socket { + task { let arr = Array.zeroCreate n let offset = ref 0 let reader = connection.reader @@ -145,7 +144,7 @@ module WebSocket = let target = new Span(arr,!offset,count) source.CopyTo(target) offset := !offset + count) - return arr + return Ok(arr) } let readBytesIntoByteSegment retrieveByteSegment (connection : Connection) (n : int) = @@ -159,13 +158,13 @@ module WebSocket = let offset = ref 0 let reader = connection.reader - socket{ + task{ do! reader.readPostData n (fun a count -> let source = a.Span.Slice(0,count) let target = byteSegment.Span.Slice(!offset,count) source.CopyTo(target) offset := !offset + count) - return byteSegment + return Ok(byteSegment) } type internal Cont<'t> = 't -> unit @@ -208,29 +207,6 @@ module WebSocket = let frame = frame opcode bs fin runAsyncWithSemaphore writeSemaphore (writeFrame connection frame) - let readFrame () = socket { - //assert (Seq.length connection.segments = 0) - let! arr = readBytes connection 2 - let header = exctractHeader arr - let! extendedLength = readExtendedLength header - - assert(header.hasMask) - let! mask = readBytes connection 4 - - if extendedLength > uint64 Int32.MaxValue then - let reason = "Frame size of " + extendedLength.ToString() + " bytes exceeds maximum accepted frame size (2 GB)" - let data = - [| yield! BitConverter.GetBytes (CloseCode.CLOSE_TOO_LARGE.code) |> bytesToNetworkOrder - yield! Encoding.UTF8.GetBytes reason |] - do! sendFrame Close (Memory(data)) true - return! SocketOp.abort (InputDataError(None, reason)) - else - let! frame = readBytes connection (int extendedLength) - // Messages from the client MUST be masked - let data = if header.hasMask then frame |> Array.mapi (fun i x -> x ^^^ mask.[i % 4]) else frame - return (header.opcode, data, header.fin) - } - let readFrameIntoSegment (byteSegmentForLengthFunc: int -> ByteSegment) = socket { //assert (Seq.length connection.segments = 0) let! arr = readBytes connection 2 @@ -256,16 +232,12 @@ module WebSocket = for i = 0 to (int extendedLength) - 1 do frame.Span.[i] <- frame.Span.[i] ^^^ mask.[i % 4] - return (header.opcode, frame, header.fin) + return header.opcode, frame, header.fin } - member this.read () = task { - let! result = runAsyncWithSemaphore readSemaphore (readFrameIntoSegment (Array.zeroCreate >> Memory)) - return - match result with - | Ok(opcode, frame, header) -> Ok(opcode, frame, header) - | Result.Error(error) -> Result.Error(error) - } + member this.read () = socket { + return! runAsyncWithSemaphore readSemaphore (readFrameIntoSegment (Array.zeroCreate >> Memory)) + } /// Reads from the websocket and puts the data into a ByteSegment selected by the byteSegmentForLengthFunc parameter /// A function that takes in the message length in bytes required to hold the next websocket message and returns an appropriately sized ArraySegment of bytes @@ -336,8 +308,7 @@ module WebSocket = | Ok _ -> do () | Result.Error err -> - ctx.runtime.logger.warn (eventX "WebSocket disconnected {error}" >> setSingleName "Suave.Websocket.handShakeWithSubprotocol" - >> setFieldValue "error" err) + do () return! Control.CLOSE ctx | Choice2Of2 response -> return! response } @@ -351,8 +322,7 @@ module WebSocket = | Ok _ -> do () | Result.Error err -> - ctx.runtime.logger.warn (eventX "WebSocket disconnected {error}" >> setSingleName "Suave.Websocket.handShake" - >> setFieldValue "error" err) + Console.WriteLine($"WebSocket disconnected {err}",err) return! Control.CLOSE ctx | Choice2Of2 response -> return! response