oceanbox/Fable.SignalR
6
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases 18 Wiki Activity

Bump version to 0.9.0

Browse Source
This commit is contained in:
Shmew
2020-10-23 11:00:54 -05:00
parent 0b6d33cf64
commit feebd0e091
47 changed files with 3294 additions and 363 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
.github/workflows/stale.yml vendored
View File

@@ -1,19 +0,0 @@
name: Mark stale issues and pull requests
on:
schedule:
- cron: "0 0 * * *"
jobs:
stale:
runs-on: ubuntu-latest
steps:
- uses: actions/stale@v1
with:
repo-token: ${{ secrets.GITHUB_TOKEN }}
stale-issue-message: 'Stale issue message'
stale-pr-message: 'Stale pull request message'
stale-issue-label: 'no-issue-activity'
stale-pr-label: 'no-pr-activity'

26
Fable.SignalR.sln
View File

@@ -55,6 +55,7 @@ Project("{2150E333-8FDC-42A3-9474-1A3956D46DE8}") = "docs", "docs", "{D05F59F8-1
ProjectSection(SolutionItems) = preProject
docs\authorization.md = docs\authorization.md
docs\contributing.md = docs\contributing.md
docs\dotnet-client.md = docs\dotnet-client.md
docs\index.html = docs\index.html
docs\installation.md = docs\installation.md
docs\integration-testing.md = docs\integration-testing.md
@@ -113,6 +114,14 @@ Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "Fable.SignalR.TestShared",
EndProject
Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "Bench", "tests\Bench\Bench.fsproj", "{DCCCDD76-0140-4882-BB1E-96EB427720ED}"
EndProject
Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "Fable.SignalR.DotNet", "src\Fable.SignalR.DotNet\Fable.SignalR.DotNet.fsproj", "{DBB95791-058C-4970-B704-D10F02076596}"
EndProject
Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "Fable.SignalR.Shared", "src\Fable.SignalR.Shared\Fable.SignalR.Shared.fsproj", "{EE2A2B10-4862-4BFC-9F66-0BB0DE3A521E}"
EndProject
Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "Fable.SignalR.DotNet.Elmish", "src\Fable.SignalR.DotNet.Elmish\Fable.SignalR.DotNet.Elmish.fsproj", "{72C39C35-A803-4D38-992D-28FB6FD880FC}"
EndProject
Project("{6EC3EE1D-3C4E-46DD-8F32-0CC8E7565705}") = "Fable.SignalR.DotNet.Tests", "tests\Fable.SignalR.DotNet.Tests\Fable.SignalR.DotNet.Tests.fsproj", "{F42ADD8F-C6F1-4D82-A08B-8454ABDC3010}"
EndProject
Global
GlobalSection(SolutionConfigurationPlatforms) = preSolution
Debug|Any CPU = Debug|Any CPU
@@ -171,6 +180,22 @@ Global
{DCCCDD76-0140-4882-BB1E-96EB427720ED}.Debug|Any CPU.Build.0 = Debug|Any CPU
{DCCCDD76-0140-4882-BB1E-96EB427720ED}.Release|Any CPU.ActiveCfg = Release|Any CPU
{DCCCDD76-0140-4882-BB1E-96EB427720ED}.Release|Any CPU.Build.0 = Release|Any CPU
{DBB95791-058C-4970-B704-D10F02076596}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{DBB95791-058C-4970-B704-D10F02076596}.Debug|Any CPU.Build.0 = Debug|Any CPU
{DBB95791-058C-4970-B704-D10F02076596}.Release|Any CPU.ActiveCfg = Release|Any CPU
{DBB95791-058C-4970-B704-D10F02076596}.Release|Any CPU.Build.0 = Release|Any CPU
{EE2A2B10-4862-4BFC-9F66-0BB0DE3A521E}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{EE2A2B10-4862-4BFC-9F66-0BB0DE3A521E}.Debug|Any CPU.Build.0 = Debug|Any CPU
{EE2A2B10-4862-4BFC-9F66-0BB0DE3A521E}.Release|Any CPU.ActiveCfg = Release|Any CPU
{EE2A2B10-4862-4BFC-9F66-0BB0DE3A521E}.Release|Any CPU.Build.0 = Release|Any CPU
{72C39C35-A803-4D38-992D-28FB6FD880FC}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{72C39C35-A803-4D38-992D-28FB6FD880FC}.Debug|Any CPU.Build.0 = Debug|Any CPU
{72C39C35-A803-4D38-992D-28FB6FD880FC}.Release|Any CPU.ActiveCfg = Release|Any CPU
{72C39C35-A803-4D38-992D-28FB6FD880FC}.Release|Any CPU.Build.0 = Release|Any CPU
{F42ADD8F-C6F1-4D82-A08B-8454ABDC3010}.Debug|Any CPU.ActiveCfg = Debug|Any CPU
{F42ADD8F-C6F1-4D82-A08B-8454ABDC3010}.Debug|Any CPU.Build.0 = Debug|Any CPU
{F42ADD8F-C6F1-4D82-A08B-8454ABDC3010}.Release|Any CPU.ActiveCfg = Release|Any CPU
{F42ADD8F-C6F1-4D82-A08B-8454ABDC3010}.Release|Any CPU.Build.0 = Release|Any CPU
EndGlobalSection
GlobalSection(SolutionProperties) = preSolution
HideSolutionNode = FALSE
@@ -187,6 +212,7 @@ Global
{6DCEC050-2B9B-4DF7-AE21-D554965EF5A1} = {27F9F1A6-C6B4-4539-B013-8549B4A6E1B5}
{BE9FFEDE-5036-46EA-A4EA-345476C2F678} = {27F9F1A6-C6B4-4539-B013-8549B4A6E1B5}
{DCCCDD76-0140-4882-BB1E-96EB427720ED} = {27F9F1A6-C6B4-4539-B013-8549B4A6E1B5}
{F42ADD8F-C6F1-4D82-A08B-8454ABDC3010} = {27F9F1A6-C6B4-4539-B013-8549B4A6E1B5}
EndGlobalSection
GlobalSection(ExtensibilityGlobals) = postSolution
SolutionGuid = {96DAE6A9-B1CC-4FF7-B08C-D5FBFD55B385}

13
README.md
View File

@@ -1,12 +1,12 @@
# Fable.SignalR [![Nuget](https://img.shields.io/nuget/v/Fable.SignalR.svg?maxAge=0&colorB=brightgreen&label=Fable.SignalR)](https://www.nuget.org/packages/Fable.SignalR)
Fable bindings for the SignalR client, and ASP.NET Core/Giraffe/Saturn wrappers for SignalR server hubs.
Fable bindings for the SignalR client, a wrapper for the .NET client,
and ASP.NET Core/Giraffe/Saturn wrappers for SignalR server hubs.
The full documentation can be found [here](https://shmew.github.io/Fable.SignalR/)
The full documentation can be found [here](https://shmew.github.io/Fable.SignalR/).
A quick look:
### On the client
On the client:
```fsharp
let textDisplay = React.functionComponent(fun (input: {| count: int; text: string |}) ->
React.fragment [
@@ -53,7 +53,7 @@ let render = React.functionComponent(fun () ->
])
```
On the server:
### On the server
```fsharp
module SignalRHub =
@@ -89,7 +89,8 @@ application {
...
}
```
The shared file:
### The shared file
```fsharp
[<RequireQualifiedAccess>]

5
RELEASE_NOTES.md
View File

@@ -1,6 +1,9 @@
### 0.9.0 - Friday, October 23rd, 2020
* Added support for the .NET client
### 0.8.3 - Tuesday, October 13th, 2020
* Fix issue with MsgPack protocol handling when messages
are batched.
are batched
### 0.8.2 - Monday, October 12th, 2020
* Pin Fable.SimpleJson

4
appveyor.yml
View File

@@ -10,10 +10,8 @@ install:
cache:
- .cache/yarn
build_script:
- cmd: build.cmd -t CopyBinaries
- cmd: build.cmd -t CI
test: off
test_script:
- yarn test-server
version: 0.0.1.{build}
artifacts:
- path: bin

35
build.fsx
View File

@@ -57,16 +57,17 @@ let (|Fsproj|Csproj|Vbproj|Shproj|) (projFileName:string) =
| f when f.EndsWith("shproj") -> Shproj
| _ -> failwith (sprintf "Project file %s not supported. Unknown project type." projFileName)
let srcGlob = __SOURCE_DIRECTORY__ @@ "src/**/*.??proj"
let fsSrcGlob = __SOURCE_DIRECTORY__ @@ "src/**/*.fs"
let fsTestGlob = __SOURCE_DIRECTORY__ @@ "tests/**/*.fs"
let bin = __SOURCE_DIRECTORY__ @@ "bin"
let docs = __SOURCE_DIRECTORY__ @@ "docs"
let temp = __SOURCE_DIRECTORY__ @@ "temp"
let objFolder = __SOURCE_DIRECTORY__ @@ "obj"
let dist = __SOURCE_DIRECTORY__ @@ "dist"
let libGlob = __SOURCE_DIRECTORY__ @@ "src/**/*.fsproj"
let demoGlob = __SOURCE_DIRECTORY__ @@ "demo/**/*.fsproj"
let srcGlob = __SOURCE_DIRECTORY__ @@ "src/**/*.??proj"
let fsSrcGlob = __SOURCE_DIRECTORY__ @@ "src/**/*.fs"
let fsTestGlob = __SOURCE_DIRECTORY__ @@ "tests/**/*.fs"
let bin = __SOURCE_DIRECTORY__ @@ "bin"
let docs = __SOURCE_DIRECTORY__ @@ "docs"
let temp = __SOURCE_DIRECTORY__ @@ "temp"
let objFolder = __SOURCE_DIRECTORY__ @@ "obj"
let dist = __SOURCE_DIRECTORY__ @@ "dist"
let libGlob = __SOURCE_DIRECTORY__ @@ "src/**/*.fsproj"
let demoGlob = __SOURCE_DIRECTORY__ @@ "demo/**/*.fsproj"
let dotnetTestGlob = __SOURCE_DIRECTORY__ @@ "tests/*DotNet*/*.fsproj"
let foldExcludeGlobs (g: IGlobbingPattern) (d: string) = g -- d
let foldIncludeGlobs (g: IGlobbingPattern) (d: string) = g ++ d
@@ -224,6 +225,7 @@ Target.create "Build" <| fun _ ->
!! libGlob
++ demoGlob
++ dotnetTestGlob
|> List.ofSeq
|> List.iter (MSBuild.build setParams)
@@ -250,6 +252,7 @@ Target.create "PublishDotNet" <| fun _ ->
!! libGlob
++ demoGlob
++ dotnetTestGlob
|> Seq.map
((fun f -> (((Path.getDirectory f) @@ "bin" @@ configuration()), f) )
>>
@@ -281,6 +284,15 @@ Target.create "Lint" <| fun _ ->
Target.create "RunTests" <| fun _ ->
Yarn.exec "test-server" id
!! (__SOURCE_DIRECTORY__ @@ "tests/**/bin" @@ configuration() @@ "**/*Tests.exe")
|> Seq.iter (fun f ->
Command.RawCommand(f, Arguments.Empty)
|> CreateProcess.fromCommand
|> CreateProcess.withTimeout (System.TimeSpan.MaxValue)
|> CreateProcess.ensureExitCodeWithMessage "Tests failed."
|> Proc.run
|> ignore)
// --------------------------------------------------------------------------------------
// Update package.json version & name
@@ -367,6 +379,7 @@ Target.create "All" ignore
Target.create "Dev" ignore
Target.create "Release" ignore
Target.create "Publish" ignore
Target.create "CI" ignore
"Clean"
==> "Restore"
@@ -428,4 +441,6 @@ Target.create "Publish" ignore
"Publish" <== ["Release"; "ConfigRelease"; "NuGetPublish"; "PublishDocs"; "GitTag"; "GitPush" ]
"CI" <== ["CopyBinaries"; "RunTests"]
Target.runOrDefaultWithArguments "Dev"

10
docs/README.md
View File

@@ -1,10 +1,10 @@
# Fable.SignalR [![Nuget](https://img.shields.io/nuget/v/Fable.SignalR.svg?maxAge=0&colorB=brightgreen&label=Fable.SignalR)](https://www.nuget.org/packages/Fable.SignalR)
Fable bindings for the SignalR client, and ASP.NET Core/Giraffe/Saturn wrappers for SignalR server hubs.
Fable bindings for the SignalR client, a wrapper for the .NET client,
and ASP.NET Core/Giraffe/Saturn wrappers for SignalR server hubs.
A quick look:
### On the client
On the client:
```fsharp
let textDisplay = React.functionComponent(fun (input: {| count: int; text: string |}) ->
React.fragment [
@@ -51,7 +51,7 @@ let render = React.functionComponent(fun () ->
])
```
On the server:
### On the server
```fsharp
module SignalRHub =
@@ -88,7 +88,7 @@ application {
}
```
The shared file:
### The shared file
```fsharp
[<RequireQualifiedAccess>]

5
docs/RELEASE_NOTES.md
View File

@@ -1,6 +1,9 @@
### 0.9.0 - Friday, October 23rd, 2020
* Added support for the .NET client
### 0.8.3 - Tuesday, October 13th, 2020
* Fix issue with MsgPack protocol handling when messages
are batched.
are batched
### 0.8.2 - Monday, October 12th, 2020
* Pin Fable.SimpleJson

11
docs/authorization.md
View File

@@ -120,3 +120,14 @@ to authenticate. If you do not, your transport **will be downgraded**.
hub.withUrl(Endpoints.Root, fun builder -> builder.accessTokenFactory(myAccessTokenFunction))
...
```
## On the .NET client
The above notes apply for the .NET client as well.
```fsharp
hub.WithUrl(Endpoints.Root, fun o ->
o.AccessTokenProvider <- fun () -> myAccessTokenFunction |> Async.StartAsTask
)
...
```

17
docs/dotnet-client.md Normal file
View File

@@ -0,0 +1,17 @@
# .NET Client
The API (mostly) matches that of the Fable client, either the sections titled
`Native` when just using `Fable.SignalR.DotNet`, and `Elmish` when
additionally using the `Fable.SignalR.DotNet.Elmish`.
There are a couple differences:
* You cannot define `OnMessage` at the declaration site of the hub,
but rather at the points where you want to listen for a message.
In most cases this may simply be right after you define the hub, but as it returns
a `System.IDisposable` you can control when and where you listen for messages.
* Streaming is done via `IAsyncEnumerable` rather than the custom types used in the
Fable client. [FSharp.Control.AsyncSeq](https://github.com/fsprojects/FSharp.Control.AsyncSeq)
is highly recommended for handling these.
* Instance methods are uppercase rather than lowercase.

4
docs/index.html
View File

@@ -67,6 +67,10 @@
{ title: "API Reference", link: "/signalr-client/api" }
]
},
{
title: ".NET Client",
link: "/dotnet-client"
},
{
title: "Server Configuration",
links: [

19
docs/installation.md
View File

@@ -66,3 +66,22 @@ dotnet add package Fable.SignalR.Saturn // For Saturn
paket add Fable.SignalR.AspNetCore --project ./project/path // For ASP.NET Core or Giraffe
paket add Fable.SignalR.Saturn --project ./project/path // For Saturn
```
## .NET Client
To install for .NET clients add one (or both) of the following
nuget packages into your F# project:
* Fable.SignalR.DotNet
* Fable.SignalR.DotNet.Elmish
- If you want to use Elmish Cmds.
```bash
# nuget
dotnet add package Fable.SignalR.DotNet
dotnet add package Fable.SignalR.DotNet.Elmish
# paket
paket add Fable.SignalR.DotNet --project ./project/path
paket add Fable.SignalR.DotNet.Elmish --project ./project/path
```

8
docs/integration-testing.md
View File

@@ -55,3 +55,11 @@ let hub =
hub ...
.configureLogging(LogLevel.None)
```
### On the .NET client
```fsharp
let hub =
hub ...
.configureLogging(fun logBuilder -> logBuilder.SetMinimumLevel(LogLevel.None))
```

2
package.json
View File

@@ -1,6 +1,6 @@
{
"name": "fable.-signal-r",
"version": "0.8.3",
"version": "0.9.0",
"description": "Fable and server bindings for SignalR.",
"homepage": "https://github.com/Shmew/Fable.SignalR",
"bugs": {

42
paket.dependencies
View File

@@ -21,9 +21,39 @@ group Fable.SignalR.AspNetCore
nuget Fable.Remoting.MsgPack ~> 1
nuget FSharp.Core ~> 4.7
nuget Microsoft.AspNetCore.SignalR.Protocols.NewtonsoftJson ~> 3
nuget Microsoft.Toolkit.HighPerformance ~> 6
nuget TaskBuilder.fs ~> 2
group Fable.SignalR.DotNet
source https://nuget.org/api/v2
source https://api.nuget.org/v3/index.json
nuget Fable.Remoting.Json ~> 2
nuget Fable.Remoting.MsgPack ~> 1
nuget FSharp.Core ~> 4.7
nuget Microsoft.AspNetCore.SignalR.Client ~> 3
nuget Microsoft.AspNetCore.SignalR.Protocols.NewtonsoftJson ~> 3
group Fable.SignalR.DotNet.Elmish
source https://nuget.org/api/v2
source https://api.nuget.org/v3/index.json
nuget Elmish ~> 3
nuget Fable.Remoting.Json ~> 2
nuget Fable.Remoting.MsgPack ~> 1
nuget FSharp.Core ~> 4.7
nuget Microsoft.AspNetCore.SignalR.Client ~> 3
nuget Microsoft.AspNetCore.SignalR.Protocols.NewtonsoftJson ~> 3
group Fable.SignalR.DotNet.Tests
source https://nuget.org/api/v2
source https://api.nuget.org/v3/index.json
nuget Expecto ~> 9
nuget Expecto.FsCheck ~> 9
nuget FSharp.Control.AsyncSeq ~> 3
nuget FSharp.Core ~> 4.7
nuget Microsoft.AspNetCore.TestHost ~> 3
group Fable.SignalR.Elmish
source https://nuget.org/api/v2
source https://api.nuget.org/v3/index.json
@@ -51,6 +81,15 @@ group Fable.SignalR.Saturn
nuget Microsoft.AspNetCore.SignalR.Protocols.NewtonsoftJson ~> 3
nuget Saturn ~> 0
group Fable.SignalR.Shared
source https://nuget.org/api/v2
source https://api.nuget.org/v3/index.json
nuget Fable.Remoting.Json ~> 2
nuget Fable.Remoting.MsgPack ~> 1
nuget FSharp.Core ~> 4.7
nuget Microsoft.AspNetCore.SignalR.Protocols.NewtonsoftJson ~> 3
group Fable.SignalR.Tests
source https://nuget.org/api/v2
source https://api.nuget.org/v3/index.json
@@ -141,6 +180,7 @@ group FakeBuild
nuget Fake.JavaScript.Yarn ~> 5
nuget Fake.JavaScript.Npm ~> 5
nuget Fake.Tools.Git ~> 5
nuget FSharp.Core ~> 4.7
nuget FSharp.Json ~> 0
nuget FSharpLint.Core ~> 0
nuget NuGet.Packaging 5.6

1326
paket.lock
View File

File diff suppressed because it is too large Load Diff

2
src/Fable.SignalR.AspNetCore/AspNetCore.fs
View File

@@ -3,7 +3,7 @@
[<AutoOpen>]
module SignalRExtension =
open Fable.Remoting.Json
open Fable.SignalR
open Fable.SignalR.Shared
open Microsoft.AspNetCore.Builder
open Microsoft.AspNetCore.SignalR
open Microsoft.AspNetCore.SignalR.Protocol

6
src/Fable.SignalR.AspNetCore/Fable.SignalR.AspNetCore.fsproj
View File

@@ -5,9 +5,6 @@
<TargetFramework>netcoreapp3.1</TargetFramework>
</PropertyGroup>
<ItemGroup>
<Compile Include="Shared.fs" />
<Compile Include="MemoryCache.fs" />
<Compile Include="MsgPack.fs" />
<Compile Include="Server.fs" />
<Compile Include="WebSocketsMiddleware.fs" />
<Compile Include="AspNetCore.fs" />
@@ -17,5 +14,8 @@
<ItemGroup Condition=" '$(TargetFramework)' == 'netcoreapp3.1' ">
<FrameworkReference Include="Microsoft.AspNetCore.App" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\Fable.SignalR.Shared\Fable.SignalR.Shared.fsproj" />
</ItemGroup>
<Import Project="..\..\.paket\Paket.Restore.targets" />
</Project>

1
src/Fable.SignalR.AspNetCore/paket.references
View File

@@ -3,5 +3,4 @@
Fable.Remoting.MsgPack
FSharp.Core
Microsoft.AspNetCore.SignalR.Protocols.NewtonsoftJson
Microsoft.Toolkit.HighPerformance
TaskBuilder.fs

715
src/Fable.SignalR.DotNet.Elmish/Elmish.fs Normal file
View File

@@ -0,0 +1,715 @@
namespace Fable.SignalR
open Elmish
open Fable.Remoting.Json
open Fable.SignalR.Shared
open Microsoft.AspNetCore.Http.Connections
open Microsoft.AspNetCore.Http.Connections.Client
open Microsoft.AspNetCore.SignalR.Client
open Microsoft.AspNetCore.SignalR.Protocol
open Microsoft.Extensions.Logging
open Microsoft.Extensions.DependencyInjection
open Newtonsoft.Json
open System
open System.Collections.Generic
[<RequireQualifiedAccess>]
module private Async =
let map f a =
async {
let! res = a
return f res
}
module Elmish =
[<RequireQualifiedAccess>]
module Elmish =
type HubConnectionBuilder<'ClientApi,'ClientStreamFromApi,'ClientStreamToApi,'ServerApi,'ServerStreamApi,'Msg>
internal (hub: IHubConnectionBuilder, dispatch: 'Msg -> unit) =
let mutable hub = hub
let mutable handlers = Handlers.empty
let mutable onMessage : ('ServerApi -> unit) option = None
let mutable useMsgPack = false
/// Configures logging for the HubConnection.
member this.ConfigureLogging (f: ILoggingBuilder -> ILoggingBuilder) =
hub <- hub.ConfigureLogging(Action<ILoggingBuilder> (f >> ignore))
this
/// Callback when the connection is closed.
member this.OnClosed (callback: exn option -> Async<'Msg>) =
handlers <- { handlers with OnClosed = Some (callback >> Async.map dispatch) }
this
/// Configures the HubConnection to callback when a new message is recieved.
member this.OnMessage (callback: 'ServerApi -> 'Msg) =
onMessage <- Some (callback >> dispatch)
this
/// Callback when the connection successfully reconnects.
member this.OnReconnected (callback: string option -> Async<'Msg>) =
handlers <- { handlers with OnReconnected = Some (callback >> Async.map dispatch) }
this
/// Callback when the connection starts reconnecting.
member this.OnReconnecting (callback: exn option -> Async<'Msg>) =
handlers <- { handlers with OnReconnecting = Some (callback >> Async.map dispatch) }
this
/// Enable MessagePack binary (de)serialization instead of JSON.
member this.UseMessagePack () =
useMsgPack <- true
this
/// Configures the HubConnection to use HTTP-based transports to connect
/// to the specified URL.
///
/// The transport will be selected automatically based on what the server
/// and client support.
member this.WithUrl (url: string) =
hub <- hub.WithUrl(url)
this
/// Configures the HubConnection to use HTTP-based transports to connect
/// to the specified URL.
///
/// The transport will be selected automatically based on what the server
/// and client support.
member this.WithUrl (url: Uri) =
hub <- hub.WithUrl(url)
this
/// Configures the HubConnection to use the specified HTTP-based transport
/// to connect to the specified URL.
member this.WithUrl (url: string, transportType: HttpTransportType) =
hub <- hub.WithUrl(url, transportType)
this
/// Configures the HubConnection to use HTTP-based transports to connect to
/// the specified URL.
member this.WithUrl (url: string, options: HttpConnectionOptions -> unit) =
hub <- hub.WithUrl(url, options)
this
/// Configures the HubConnection to use HTTP-based transports to connect to
/// the specified URL.
member this.WithUrl (url: Uri, options: HttpConnectionOptions -> unit) =
hub <- hub.WithUrl(url, options)
this
/// Configures the HubConnection to use the specified Hub Protocol.
member this.WithServices (f: IServiceCollection -> unit) =
f hub.Services
this
/// Configures the HubConnection to use the specified Hub Protocol.
member this.WithServices (f: IServiceCollection -> IServiceCollection) =
f hub.Services |> ignore
this
/// Configures the HubConnection to automatically attempt to reconnect
/// if the connection is lost.
///
/// By default, the client will wait 0, 2, 10 and 30 seconds respectively
/// before trying up to 4 reconnect attempts.
member this.WithAutomaticReconnect () =
hub <- hub.WithAutomaticReconnect()
this
/// Configures the HubConnection to automatically attempt to reconnect if the
/// connection is lost.
///
/// An array containing the delays in milliseconds before trying each reconnect
/// attempt. The length of the array represents how many failed reconnect attempts
/// it takes before the client will stop attempting to reconnect.
member this.WithAutomaticReconnect (retryDelays: seq<TimeSpan>) =
hub <- hub.WithAutomaticReconnect(Array.ofSeq retryDelays)
this
/// Configures the HubConnection to automatically attempt to reconnect if the
/// connection is lost.
member this.WithAutomaticReconnect (reconnectPolicy: IRetryPolicy) =
hub <- hub.WithAutomaticReconnect(reconnectPolicy)
this
member internal _.Build () =
if useMsgPack then
hub.Services.AddSingleton<IHubProtocol,MsgPackProtocol.FableHubProtocol<'ClientApi,'ClientStreamFromApi,'ClientStreamToApi,'ServerApi,'ServerStreamApi>>()
|> ignore
hub
else
hub.AddNewtonsoftJsonProtocol(fun o ->
o.PayloadSerializerSettings.DateParseHandling <- DateParseHandling.None
o.PayloadSerializerSettings.ContractResolver <- new Serialization.DefaultContractResolver()
o.PayloadSerializerSettings.Converters.Add(FableJsonConverter()))
|> fun hub -> IHubConnection<'ClientApi,'ClientStreamFromApi,'ClientStreamToApi,'ServerApi,'ServerStreamApi>(hub.Build())
|> fun hub -> new HubConnection<'ClientApi,'ClientStreamFromApi,'ClientStreamToApi,'ServerApi,'ServerStreamApi>(hub, handlers)
|> fun hub -> hub, onMessage
type Hub<'ClientApi,'ServerApi> internal (hub: HubConnection<'ClientApi,unit,unit,'ServerApi,unit>, ?onMsg: 'ServerApi -> unit) =
let onMsgDisposable =
match onMsg with
| Some onMsg ->
hub.OnMessage(fun msg -> async { return onMsg msg })
|> Some
| None -> None
interface IDisposable with
member this.Dispose () = this.Dispose()
member internal _.Hub = hub
member internal _.Cts = new System.Threading.CancellationTokenSource()
member this.Dispose () =
(hub :> IDisposable).Dispose()
this.Cts.Cancel()
this.Cts.Dispose()
onMsgDisposable |> Option.iter (fun d -> d.Dispose())
/// Default interval at which to ping the server.
///
/// The default value is 15,000 milliseconds (15 seconds).
/// Allows the server to detect hard disconnects (like when a client unplugs their computer).
member this.KeepAliveInterval = this.Hub.KeepAliveInterval
/// The server timeout in milliseconds.
///
/// If this timeout elapses without receiving any messages from the server, the connection will be terminated with an error.
/// The default timeout value is 30,000 milliseconds (30 seconds).
member this.ServerTimeout = this.Hub.ServerTimeout
module StreamHub =
type Bidrectional<'ClientApi,'ClientStreamFromApi,'ClientStreamToApi,'ServerApi,'ServerStreamApi>
internal (hub: HubConnection<'ClientApi,'ClientStreamFromApi,'ClientStreamToApi,'ServerApi,'ServerStreamApi>, ?onMsg: 'ServerApi -> unit) =
let onMsgDisposable =
match onMsg with
| Some onMsg ->
hub.OnMessage(fun msg -> async { return onMsg msg })
|> Some
| None -> None
interface IDisposable with
member this.Dispose () = this.Dispose()
member internal _.Hub = hub
member internal _.Cts = new System.Threading.CancellationTokenSource()
member this.Dispose () =
(hub :> IDisposable).Dispose()
this.Cts.Cancel()
this.Cts.Dispose()
onMsgDisposable |> Option.iter (fun d -> d.Dispose())
/// Default interval at which to ping the server.
///
/// The default value is 15,000 milliseconds (15 seconds).
/// Allows the server to detect hard disconnects (like when a client unplugs their computer).
member this.KeepAliveInterval = this.Hub.KeepAliveInterval
/// The server timeout in milliseconds.
///
/// If this timeout elapses without receiving any messages from the server, the connection will be terminated with an error.
/// The default timeout value is 30,000 milliseconds (30 seconds).
member this.ServerTimeout = this.Hub.ServerTimeout
type ServerToClient<'ClientApi,'ClientStreamApi,'ServerApi,'ServerStreamApi>
internal (hub: HubConnection<'ClientApi,'ClientStreamApi,unit,'ServerApi,'ServerStreamApi>, ?onMsg: 'ServerApi -> unit) =
let onMsgDisposable =
match onMsg with
| Some onMsg ->
hub.OnMessage(fun msg -> async { return onMsg msg })
|> Some
| None -> None
interface IDisposable with
member this.Dispose () = this.Dispose()
member internal _.Hub = hub
member internal _.Cts = new System.Threading.CancellationTokenSource()
member this.Dispose () =
(hub :> IDisposable).Dispose()
this.Cts.Cancel()
this.Cts.Dispose()
onMsgDisposable |> Option.iter (fun d -> d.Dispose())
/// Default interval at which to ping the server.
///
/// The default value is 15,000 milliseconds (15 seconds).
/// Allows the server to detect hard disconnects (like when a client unplugs their computer).
member this.KeepAliveInterval = this.Hub.KeepAliveInterval
/// The server timeout in milliseconds.
///
/// If this timeout elapses without receiving any messages from the server, the connection will be terminated with an error.
/// The default timeout value is 30,000 milliseconds (30 seconds).
member this.ServerTimeout = this.Hub.ServerTimeout
type ClientToServer<'ClientApi,'ClientStreamApi,'ServerApi>
internal (hub: HubConnection<'ClientApi,unit,'ClientStreamApi,'ServerApi,unit>, ?onMsg: 'ServerApi -> unit) =
let onMsgDisposable =
match onMsg with
| Some onMsg ->
hub.OnMessage(fun msg -> async { return onMsg msg })
|> Some
| None -> None
interface IDisposable with
member this.Dispose () = this.Dispose()
member internal _.Hub = hub
member internal _.Cts = new System.Threading.CancellationTokenSource()
member this.Dispose () =
(hub :> IDisposable).Dispose()
this.Cts.Cancel()
this.Cts.Dispose()
onMsgDisposable |> Option.iter (fun d -> d.Dispose())
/// Default interval at which to ping the server.
///
/// The default value is 15,000 milliseconds (15 seconds).
/// Allows the server to detect hard disconnects (like when a client unplugs their computer).
member this.KeepAliveInterval = this.Hub.KeepAliveInterval
/// The server timeout in milliseconds.
///
/// If this timeout elapses without receiving any messages from the server, the connection will be terminated with an error.
/// The default timeout value is 30,000 milliseconds (30 seconds).
member this.ServerTimeout = this.Hub.ServerTimeout
[<RequireQualifiedAccess>]
module Cmd =
[<RequireQualifiedAccess>]
module SignalR =
module Stream =
module Bidrectional =
/// Starts a connection to a SignalR hub with server and client streaming enabled.
let connect
(registerHub: Elmish.StreamHub.Bidrectional<'ClientApi,'ClientStreamFromApi,'ClientStreamToApi,'ServerApi,'ServerStreamApi> -> 'Msg)
(config: Elmish.HubConnectionBuilder<'ClientApi,'ClientStreamFromApi,'ClientStreamToApi,'ServerApi,'ServerStreamApi,'Msg>
-> Elmish.HubConnectionBuilder<'ClientApi,'ClientStreamFromApi,'ClientStreamToApi,'ServerApi,'ServerStreamApi,'Msg>) : Cmd<'Msg> =
[ fun dispatch ->
let (connection, onMsg) =
Elmish.HubConnectionBuilder(HubConnectionBuilder(), dispatch)
|> config
|> fun hubBuilder -> hubBuilder.Build()
connection.StartNow()
registerHub (new Elmish.StreamHub.Bidrectional<'ClientApi,'ClientStreamFromApi,'ClientStreamToApi,'ServerApi,'ServerStreamApi>(connection, ?onMsg = onMsg))
|> dispatch ]
module ServerToClient =
/// Starts a connection to a SignalR hub with server streaming enabled.
let connect
(registerHub: Elmish.StreamHub.ServerToClient<'ClientApi,'ClientStreamApi,'ServerApi,'ServerStreamApi> -> 'Msg)
(config: Elmish.HubConnectionBuilder<'ClientApi,'ClientStreamApi,unit,'ServerApi,'ServerStreamApi,'Msg>
-> Elmish.HubConnectionBuilder<'ClientApi,'ClientStreamApi,unit,'ServerApi,'ServerStreamApi,'Msg>) : Cmd<'Msg> =
[ fun dispatch ->
let (connection, onMsg) =
Elmish.HubConnectionBuilder(HubConnectionBuilder(), dispatch)
|> config
|> fun hubBuilder -> hubBuilder.Build()
connection.StartNow()
registerHub (new Elmish.StreamHub.ServerToClient<'ClientApi,'ClientStreamApi,'ServerApi,'ServerStreamApi>(connection, ?onMsg = onMsg))
|> dispatch ]
module ClientToServer =
/// Starts a connection to a SignalR hub with client streaming enabled.
let connect
(registerHub: Elmish.StreamHub.ClientToServer<'ClientApi,'ClientStreamApi,'ServerApi> -> 'Msg)
(config: Elmish.HubConnectionBuilder<'ClientApi,unit,'ClientStreamApi,'ServerApi,unit,'Msg>
-> Elmish.HubConnectionBuilder<'ClientApi,unit,'ClientStreamApi,'ServerApi,unit,'Msg>) : Cmd<'Msg> =
[ fun dispatch ->
let (connection, onMsg) =
Elmish.HubConnectionBuilder(HubConnectionBuilder(), dispatch)
|> config
|> fun hubBuilder -> hubBuilder.Build()
connection.StartNow()
registerHub (new Elmish.StreamHub.ClientToServer<'ClientApi,'ClientStreamApi,'ServerApi>(connection, ?onMsg = onMsg))
|> dispatch ]
/// Starts a connection to a SignalR hub.
let connect
(registerHub: Elmish.Hub<'ClientApi,'ServerApi> -> 'Msg)
(config: Elmish.HubConnectionBuilder<'ClientApi,unit,unit,'ServerApi,unit,'Msg>
-> Elmish.HubConnectionBuilder<'ClientApi,unit,unit,'ServerApi,unit,'Msg>) : Cmd<'Msg> =
[ fun dispatch ->
let (connection, onMsg) =
Elmish.HubConnectionBuilder(HubConnectionBuilder(), dispatch)
|> config
|> fun hubBuilder -> hubBuilder.Build()
connection.StartNow()
registerHub (new Elmish.Hub<'ClientApi,'ServerApi>(connection, ?onMsg = onMsg))
|> dispatch ]
type SignalR =
/// Invokes a hub method on the server and maps the error.
///
/// This method resolves when the server indicates it has finished invoking the method. When it finishes,
/// the server has finished invoking the method. If the server method returns a result, it is produced as the result of
/// resolving the async call.
// fsharplint:disable-next-line
static member attempt (hub: Elmish.Hub<'ClientApi,'ServerApi> option) : 'ClientApi -> (exn -> 'Msg) -> Cmd<'Msg> =
fun (msg: 'ClientApi) (onError: exn -> 'Msg) ->
match hub with
| Some hub ->
Cmd.OfAsyncWith.attempt
(fun msg -> Async.StartImmediate(msg, hub.Cts.Token))
hub.Hub.Invoke
msg
onError
| None -> [ ignore ]
/// Invokes a hub method on the server and maps the error.
///
/// This method resolves when the server indicates it has finished invoking the method. When it finishes,
/// the server has finished invoking the method. If the server method returns a result, it is produced as the result of
/// resolving the async call.
// fsharplint:disable-next-line
static member attempt (hub: Elmish.StreamHub.Bidrectional<'ClientApi,'ClientStreamFromApi,'ClientStreamToApi,'ServerApi,'ServerStreamApi> option)
: 'ClientApi -> (exn -> 'Msg) -> Cmd<'Msg> =
fun (msg: 'ClientApi) (onError: exn -> 'Msg) ->
match hub with
| Some hub ->
Cmd.OfAsyncWith.attempt
(fun msg -> Async.StartImmediate(msg, hub.Cts.Token))
hub.Hub.Invoke
msg
onError
| None -> [ ignore ]
/// Invokes a hub method on the server and maps the error.
///
/// This method resolves when the server indicates it has finished invoking the method. When it finishes,
/// the server has finished invoking the method. If the server method returns a result, it is produced as the result of
/// resolving the async call.
// fsharplint:disable-next-line
static member attempt (hub: Elmish.StreamHub.ClientToServer<'ClientApi,'ClientStreamToApi,'ServerApi> option) : 'ClientApi -> (exn -> 'Msg) -> Cmd<'Msg> =
fun (msg: 'ClientApi) (onError: exn -> 'Msg) ->
match hub with
| Some hub ->
Cmd.OfAsyncWith.attempt
(fun msg -> Async.StartImmediate(msg, hub.Cts.Token))
hub.Hub.Invoke
msg
onError
| None -> [ ignore ]
/// Invokes a hub method on the server and maps the error.
///
/// This method resolves when the server indicates it has finished invoking the method. When it finishes,
/// the server has finished invoking the method. If the server method returns a result, it is produced as the result of
/// resolving the async call.
// fsharplint:disable-next-line
static member attempt (hub: Elmish.StreamHub.ServerToClient<'ClientApi,'ClientStreamApi,'ServerApi,'ServerStreamApi> option)
: 'ClientApi -> (exn -> 'Msg) -> Cmd<'Msg> =
fun (msg: 'ClientApi) (onError: exn -> 'Msg) ->
match hub with
| Some hub ->
Cmd.OfAsyncWith.attempt
(fun msg -> Async.StartImmediate(msg, hub.Cts.Token))
hub.Hub.Invoke
msg
onError
| None -> [ ignore ]
/// Returns the connectionId to the hub of this client.
// fsharplint:disable-next-line
static member connectionId (hub: Elmish.Hub<'ClientApi,'ServerApi> option) : (string option -> 'Msg) -> Cmd<'Msg> =
fun (msg: string option -> 'Msg) ->
[ fun dispatch -> hub |> Option.iter (fun hub -> hub.Hub.ConnectionId |> msg |> dispatch) ]
/// Returns the connectionId to the hub of this client.
// fsharplint:disable-next-line
static member connectionId (hub: Elmish.StreamHub.Bidrectional<'ClientApi,'ClientStreamFromApi,'ClientStreamToApi,'ServerApi,'ServerStreamApi> option)
: (string option -> 'Msg) -> Cmd<'Msg> =
fun (msg: string option -> 'Msg) ->
[ fun dispatch -> hub |> Option.iter (fun hub -> hub.Hub.ConnectionId |> msg |> dispatch) ]
/// Returns the connectionId to the hub of this client.
// fsharplint:disable-next-line
static member connectionId (hub: Elmish.StreamHub.ClientToServer<'ClientApi,'ClientStreamToApi,'ServerApi> option) : (string option -> 'Msg) -> Cmd<'Msg> =
fun (msg: string option -> 'Msg) ->
[ fun dispatch -> hub |> Option.iter (fun hub -> hub.Hub.ConnectionId |> msg |> dispatch) ]
/// Returns the connectionId to the hub of this client.
// fsharplint:disable-next-line
static member connectionId (hub: Elmish.StreamHub.ServerToClient<'ClientApi,'ClientStreamApi,'ServerApi,'ServerStreamApi> option)
: (string option -> 'Msg) -> Cmd<'Msg> =
fun (msg: string option -> 'Msg) ->
[ fun dispatch -> hub |> Option.iter (fun hub -> hub.Hub.ConnectionId |> msg |> dispatch) ]
/// Invokes a hub method on the server and maps the success or error.
///
/// This method resolves when the server indicates it has finished invoking the method. When it finishes,
/// the server has finished invoking the method. If the server method returns a result, it is produced as the result of
/// resolving the async call.
// fsharplint:disable-next-line
static member either (hub: Elmish.Hub<'ClientApi,'ServerApi> option) : 'ClientApi -> ('ServerApi -> 'Msg) -> (exn -> 'Msg) -> Cmd<'Msg> =
fun (msg: 'ClientApi) (onSuccess: 'ServerApi -> 'Msg) (onError: exn -> 'Msg) ->
match hub with
| Some hub ->
Cmd.OfAsyncWith.either
(fun msg -> Async.StartImmediate(msg, hub.Cts.Token))
hub.Hub.Invoke
msg
onSuccess
onError
| None -> [ ignore ]
/// Invokes a hub method on the server and maps the success or error.
///
/// This method resolves when the server indicates it has finished invoking the method. When it finishes,
/// the server has finished invoking the method. If the server method returns a result, it is produced as the result of
/// resolving the async call.
// fsharplint:disable-next-line
static member either (hub: Elmish.StreamHub.Bidrectional<'ClientApi,'ClientStreamFromApi,'ClientStreamToApi,'ServerApi,'ServerStreamApi> option)
: 'ClientApi -> ('ServerApi -> 'Msg) -> (exn -> 'Msg) -> Cmd<'Msg> =
fun (msg: 'ClientApi) (onSuccess: 'ServerApi -> 'Msg) (onError: exn -> 'Msg) ->
match hub with
| Some hub ->
Cmd.OfAsyncWith.either
(fun msg -> Async.StartImmediate(msg, hub.Cts.Token))
hub.Hub.Invoke
msg
onSuccess
onError
| None -> [ ignore ]
/// Invokes a hub method on the server and maps the success or error.
///
/// This method resolves when the server indicates it has finished invoking the method. When it finishes,
/// the server has finished invoking the method. If the server method returns a result, it is produced as the result of
/// resolving the async call.
// fsharplint:disable-next-line
static member either (hub: Elmish.StreamHub.ClientToServer<'ClientApi,'ClientStreamToApi,'ServerApi> option)
: 'ClientApi -> ('ServerApi -> 'Msg) -> (exn -> 'Msg) -> Cmd<'Msg> =
fun (msg: 'ClientApi) (onSuccess: 'ServerApi -> 'Msg) (onError: exn -> 'Msg) ->
match hub with
| Some hub ->
Cmd.OfAsyncWith.either
(fun msg -> Async.StartImmediate(msg, hub.Cts.Token))
hub.Hub.Invoke
msg
onSuccess
onError
| None -> [ ignore ]
/// Invokes a hub method on the server and maps the success or error.
///
/// This method resolves when the server indicates it has finished invoking the method. When it finishes,
/// the server has finished invoking the method. If the server method returns a result, it is produced as the result of
/// resolving the async call.
// fsharplint:disable-next-line
static member either (hub: Elmish.StreamHub.ServerToClient<'ClientApi,'ClientStreamApi,'ServerApi,'ServerStreamApi> option)
: 'ClientApi -> ('ServerApi -> 'Msg) -> (exn -> 'Msg) -> Cmd<'Msg> =
fun (msg: 'ClientApi) (onSuccess: 'ServerApi -> 'Msg) (onError: exn -> 'Msg) ->
match hub with
| Some hub ->
Cmd.OfAsyncWith.either
(fun msg -> Async.StartImmediate(msg, hub.Cts.Token))
hub.Hub.Invoke
msg
onSuccess
onError
| None -> [ ignore ]
/// Invokes a hub method on the server and maps the success.
///
/// This method resolves when the server indicates it has finished invoking the method. When it finishes,
/// the server has finished invoking the method. If the server method returns a result, it is produced as the result of
/// resolving the async call.
// fsharplint:disable-next-line
static member perform (hub: Elmish.Hub<'ClientApi,'ServerApi> option) : 'ClientApi -> ('ServerApi -> 'Msg) -> Cmd<'Msg> =
fun (msg: 'ClientApi) (onSuccess: 'ServerApi -> 'Msg) ->
match hub with
| Some hub ->
Cmd.OfAsyncWith.perform
(fun msg -> Async.StartImmediate(msg, hub.Cts.Token))
hub.Hub.Invoke
msg
onSuccess
| None -> [ ignore ]
/// Invokes a hub method on the server and maps the success.
///
/// This method resolves when the server indicates it has finished invoking the method. When it finishes,
/// the server has finished invoking the method. If the server method returns a result, it is produced as the result of
/// resolving the async call.
// fsharplint:disable-next-line
static member perform (hub: Elmish.StreamHub.Bidrectional<'ClientApi,'ClientStreamFromApi,'ClientStreamToApi,'ServerApi,'ServerStreamApi> option)
: 'ClientApi -> ('ServerApi -> 'Msg) -> Cmd<'Msg> =
fun (msg: 'ClientApi) (onSuccess: 'ServerApi -> 'Msg) ->
match hub with
| Some hub ->
Cmd.OfAsyncWith.perform
(fun msg -> Async.StartImmediate(msg, hub.Cts.Token))
hub.Hub.Invoke
msg
onSuccess
| None -> [ ignore ]
/// Invokes a hub method on the server and maps the success.
///
/// This method resolves when the server indicates it has finished invoking the method. When it finishes,
/// the server has finished invoking the method. If the server method returns a result, it is produced as the result of
/// resolving the async call.
// fsharplint:disable-next-line
static member perform (hub: Elmish.StreamHub.ClientToServer<'ClientApi,'ClientStreamToApi,'ServerApi> option)
: 'ClientApi -> ('ServerApi -> 'Msg) -> Cmd<'Msg> =
fun (msg: 'ClientApi) (onSuccess: 'ServerApi -> 'Msg) ->
match hub with
| Some hub ->
Cmd.OfAsyncWith.perform
(fun msg -> Async.StartImmediate(msg, hub.Cts.Token))
hub.Hub.Invoke
msg
onSuccess
| None -> [ ignore ]
/// Invokes a hub method on the server and maps the success.
///
/// This method resolves when the server indicates it has finished invoking the method. When it finishes,
/// the server has finished invoking the method. If the server method returns a result, it is produced as the result of
/// resolving the async call.
// fsharplint:disable-next-line
static member perform (hub: Elmish.StreamHub.ServerToClient<'ClientApi,'ClientStreamApi,'ServerApi,'ServerStreamApi> option)
: 'ClientApi -> ('ServerApi -> 'Msg) -> Cmd<'Msg> =
fun (msg: 'ClientApi) (onSuccess: 'ServerApi -> 'Msg) ->
match hub with
| Some hub ->
Cmd.OfAsyncWith.perform
(fun msg -> Async.StartImmediate(msg, hub.Cts.Token))
hub.Hub.Invoke
msg
onSuccess
| None -> [ ignore ]
/// Invokes a hub method on the server. Does not wait for a response from the receiver.
///
/// This method resolves when the client has sent the invocation to the server. The server may still
/// be processing the invocation.
// fsharplint:disable-next-line
static member send (hub: Elmish.Hub<'ClientApi,'ServerApi> option) : 'ClientApi -> Cmd<'Msg> =
fun (msg: 'ClientApi) -> [ fun _ -> hub |> Option.iter (fun hub -> hub.Hub.SendNow msg) ]
/// Invokes a hub method on the server. Does not wait for a response from the receiver.
///
/// This method resolves when the client has sent the invocation to the server. The server may still
/// be processing the invocation.
// fsharplint:disable-next-line
static member send (hub: Elmish.StreamHub.Bidrectional<'ClientApi,'ClientStreamFromApi,'ClientStreamToApi,'ServerApi,'ServerStreamApi> option)
: 'ClientApi -> Cmd<'Msg> =
fun (msg: 'ClientApi) -> [ fun _ -> hub |> Option.iter (fun hub -> hub.Hub.SendNow msg) ]
/// Invokes a hub method on the server. Does not wait for a response from the receiver.
///
/// This method resolves when the client has sent the invocation to the server. The server may still
/// be processing the invocation.
// fsharplint:disable-next-line
static member send (hub: Elmish.StreamHub.ClientToServer<'ClientApi,'ClientStreamToApi,'ServerApi> option) : 'ClientApi -> Cmd<'Msg> =
fun (msg: 'ClientApi) -> [ fun _ -> hub |> Option.iter (fun hub -> hub.Hub.SendNow msg) ]
/// Invokes a hub method on the server. Does not wait for a response from the receiver.
///
/// This method resolves when the client has sent the invocation to the server. The server may still
/// be processing the invocation.
// fsharplint:disable-next-line
static member send (hub: Elmish.StreamHub.ServerToClient<'ClientApi,'ClientStreamApi,'ServerApi,'ServerStreamApi> option) : 'ClientApi -> Cmd<'Msg> =
fun (msg: 'ClientApi) -> [ fun _ -> hub |> Option.iter (fun hub -> hub.Hub.SendNow msg) ]
/// Returns the state of the Hub connection to the server.
// fsharplint:disable-next-line
static member state (hub: Elmish.Hub<'ClientApi,'ServerApi> option) : (HubConnectionState -> 'Msg) -> Cmd<'Msg> =
fun (msg: HubConnectionState -> 'Msg) -> [ fun dispatch -> hub |> Option.iter (fun hub -> hub.Hub.State |> msg |> dispatch) ]
/// Returns the state of the Hub connection to the server.
// fsharplint:disable-next-line
static member state (hub: Elmish.StreamHub.Bidrectional<'ClientApi,'ClientStreamFromApi,'ClientStreamToApi,'ServerApi,'ServerStreamApi> option)
: (HubConnectionState -> 'Msg) -> Cmd<'Msg> =
fun (msg: HubConnectionState -> 'Msg) -> [ fun dispatch -> hub |> Option.iter (fun hub -> hub.Hub.State |> msg |> dispatch) ]
/// Returns the state of the Hub connection to the server.
// fsharplint:disable-next-line
static member state (hub: Elmish.StreamHub.ClientToServer<'ClientApi,'ClientStreamToApi,'ServerApi> option)
: (HubConnectionState -> 'Msg) -> Cmd<'Msg> =
fun (msg: HubConnectionState -> 'Msg) -> [ fun dispatch -> hub |> Option.iter (fun hub -> hub.Hub.State |> msg |> dispatch) ]
/// Returns the state of the Hub connection to the server.
// fsharplint:disable-next-line
static member state (hub: Elmish.StreamHub.ServerToClient<'ClientApi,'ClientStreamApi,'ServerApi,'ServerStreamApi> option)
: (HubConnectionState -> 'Msg) -> Cmd<'Msg> =
fun (msg: HubConnectionState -> 'Msg) -> [ fun dispatch -> hub |> Option.iter (fun hub -> hub.Hub.State |> msg |> dispatch) ]
/// Streams from the hub.
// fsharplint:disable-next-line
static member streamFrom (hub: Elmish.StreamHub.ServerToClient<'ClientApi,'ClientStreamApi,'ServerApi,'ServerStreamApi> option) =
fun (msg: 'ClientStreamApi) (subscriber: ('Msg -> unit) -> IAsyncEnumerable<'ServerStreamApi> -> unit) ->
[ fun dispatch ->
hub |> Option.iter (fun hub ->
async {
let! streamResult = hub.Hub.StreamFrom msg
return subscriber dispatch streamResult
}
|> fun a -> Async.StartImmediate(a, hub.Cts.Token)) ] : Cmd<'Msg>
/// Streams from the hub.
// fsharplint:disable-next-line
static member streamFrom (hub: Elmish.StreamHub.Bidrectional<'ClientApi,'ClientStreamFromApi,'ClientStreamToApi,'ServerApi,'ServerStreamApi> option) =
fun (msg: 'ClientStreamFromApi) (subscriber: ('Msg -> unit) -> IAsyncEnumerable<'ServerStreamApi> -> unit) ->
[ fun dispatch ->
hub |> Option.iter (fun hub ->
async {
let! streamResult = hub.Hub.StreamFrom msg
return subscriber dispatch streamResult
}
|> fun a -> Async.StartImmediate(a, hub.Cts.Token)) ] : Cmd<'Msg>
/// Streams to the hub.
// fsharplint:disable-next-line
static member streamTo (hub: Elmish.StreamHub.ClientToServer<'ClientApi,'ClientStreamToApi,'ServerApi> option) =
fun (asyncEnum: IAsyncEnumerable<'ClientStreamToApi>) ->
[ fun _ -> hub |> Option.iter (fun hub -> hub.Hub.StreamToNow(asyncEnum)) ] : Cmd<_>
/// Streams to the hub.
// fsharplint:disable-next-line
static member streamTo (hub: Elmish.StreamHub.Bidrectional<'ClientApi,'ClientStreamFromApi,'ClientStreamToApi,'ServerApi,'ServerStreamApi> option) =
fun (asyncEnum: IAsyncEnumerable<'ClientStreamToApi>) ->
[ fun _ -> hub |> Option.iter (fun hub -> hub.Hub.StreamToNow(asyncEnum)) ] : Cmd<_>

16
src/Fable.SignalR.DotNet.Elmish/Fable.SignalR.DotNet.Elmish.fsproj Normal file
View File

@@ -0,0 +1,16 @@
<?xml version="1.0" encoding="utf-8"?>
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<OutputType>Library</OutputType>
<TargetFramework>netcoreapp3.1</TargetFramework>
</PropertyGroup>
<ItemGroup>
<Compile Include="Elmish.fs" />
<None Include="paket.references" />
<None Include="paket.template" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\Fable.SignalR.DotNet\Fable.SignalR.DotNet.fsproj" />
</ItemGroup>
<Import Project="..\..\.paket\Paket.Restore.targets" />
</Project>

7
src/Fable.SignalR.DotNet.Elmish/paket.references Normal file
View File

@@ -0,0 +1,7 @@
group Fable.SignalR.DotNet.Elmish
Elmish
Fable.Remoting.Json
Fable.Remoting.MsgPack
FSharp.Core
Microsoft.AspNetCore.SignalR.Client
Microsoft.AspNetCore.SignalR.Protocols.NewtonsoftJson

8
src/Fable.SignalR.DotNet.Elmish/paket.template Normal file
View File

@@ -0,0 +1,8 @@
type project
authors Cody Johnson
description
A type-safe functional wrapper for SignalR and .NET clients
language
F#
tags
fsharp, fable, websocket, signalr, dotnet, client, elmish

23
src/Fable.SignalR.DotNet/Common.fs Normal file
View File

@@ -0,0 +1,23 @@
namespace Fable.SignalR
open System
open System.Threading.Tasks
[<RequireQualifiedAccess>]
module internal HubMethod =
let [<Literal>] Invoke = "Invoke"
let [<Literal>] Send = "Send"
let [<Literal>] StreamFrom = "StreamFrom"
let [<Literal>] StreamTo = "StreamTo"
[<AutoOpen>]
module internal Util =
let genTask (t: Task<_>) : Task = upcast t
let wrapEvent (f: 'T option -> Async<unit>) =
System.Func<'T,Task> (
Option.ofObj
>> f
>> Async.StartAsTask
>> genTask
)

21
src/Fable.SignalR.DotNet/Fable.SignalR.DotNet.fsproj Normal file
View File

@@ -0,0 +1,21 @@
<?xml version="1.0" encoding="utf-8"?>
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<OutputType>Library</OutputType>
<TargetFramework>netcoreapp3.1</TargetFramework>
</PropertyGroup>
<ItemGroup>
<Compile Include="Common.fs" />
<Compile Include="HubConnection.fs" />
<Compile Include="SignalR.fs" />
<None Include="paket.references" />
<None Include="paket.template" />
</ItemGroup>
<ItemGroup Condition=" '$(TargetFramework)' == 'netcoreapp3.1' ">
<FrameworkReference Include="Microsoft.AspNetCore.App" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\Fable.SignalR.Shared\Fable.SignalR.Shared.fsproj" />
</ItemGroup>
<Import Project="..\..\.paket\Paket.Restore.targets" />
</Project>

422
src/Fable.SignalR.DotNet/HubConnection.fs Normal file
View File

@@ -0,0 +1,422 @@
namespace Fable.SignalR
open Fable.SignalR.Shared
open Microsoft.AspNetCore.SignalR.Client
open System
open System.Collections.Generic
open System.Threading
open System.Threading.Tasks
type internal IHubConnection<'ClientApi,'ClientStreamFromApi,'ClientStreamToApi,'ServerApi,'ServerStreamApi> (hub: HubConnection) =
member _.ConnectionId =
match hub.ConnectionId with
| null -> None
| id -> Some id
member _.Hub = hub
member _.Invoke (msg: 'ClientApi, invocationId: System.Guid, ?cancellationToken: CancellationToken) =
match cancellationToken with
| Some ct -> hub.InvokeAsync<unit>(HubMethod.Invoke, msg, invocationId, ct)
| None -> hub.InvokeAsync<unit>(HubMethod.Invoke, msg, invocationId)
|> Async.AwaitTask
member _.KeepAliveInterval = hub.KeepAliveInterval
member _.OnClosed (f: exn option -> Async<unit>) =
wrapEvent f
|> hub.add_Closed
member _.OnMessage (callback: 'ServerApi -> Async<unit>) =
hub.On<'ServerApi>(HubMethod.Send, System.Func<'ServerApi,Task>(callback >> Async.StartAsTask >> genTask))
member _.OnReconnecting (f: exn option -> Async<unit>) =
wrapEvent f
|> hub.add_Reconnecting
member _.OnReconnected (f: string option -> Async<unit>) =
wrapEvent f
|> hub.add_Reconnected
member _.RemoveClosed (f: exn option -> Async<unit>) =
wrapEvent f
|> hub.remove_Closed
member _.RemoveInvoke () = hub.Remove(HubMethod.Invoke)
member _.RemoveReconnecting (f: exn option -> Async<unit>) =
wrapEvent f
|> hub.remove_Reconnecting
member _.RemoveReconnected (f: string option -> Async<unit>) =
wrapEvent f
|> hub.remove_Reconnected
member _.RemoveSend () = hub.Remove(HubMethod.Send)
member _.Send (msg: 'ClientApi, ?cancellationToken: CancellationToken) =
match cancellationToken with
| Some ct -> hub.SendAsync(HubMethod.Send, msg, ct)
| None -> hub.SendAsync(HubMethod.Send, msg)
|> Async.AwaitTask
member this.SendNow (msg: 'ClientApi, ?cancellationToken: CancellationToken) =
this.Send(msg, ?cancellationToken = cancellationToken)
|> Async.Start
member _.ServerTimeout = hub.ServerTimeout
member _.Start (?cancellationToken: CancellationToken) =
match cancellationToken with
| Some ct -> hub.StartAsync(ct)
| None -> hub.StartAsync()
|> Async.AwaitTask
member this.StartNow (?cancellationToken: CancellationToken) =
this.Start(?cancellationToken = cancellationToken)
|> Async.Start
member _.State = hub.State
member _.Stop (?cancellationToken: CancellationToken) =
match cancellationToken with
| Some ct -> hub.StopAsync(ct)
| None -> hub.StopAsync()
|> Async.AwaitTask
member this.StopNow (?cancellationToken: CancellationToken) =
this.Stop(?cancellationToken = cancellationToken)
|> Async.Start
member _.StreamFrom (msg: 'ClientStreamFromApi, ?cancellationToken: CancellationToken) =
match cancellationToken with
| Some ct -> hub.StreamAsync<'ServerStreamApi>(HubMethod.StreamFrom, msg, ct)
| None -> hub.StreamAsync<'ServerStreamApi>(HubMethod.StreamFrom, msg)
member _.StreamTo (asyncEnum: IAsyncEnumerable<'ClientStreamToApi>, ?cancellationToken: CancellationToken) =
match cancellationToken with
| Some ct -> hub.SendAsync(HubMethod.StreamTo, asyncEnum, ct)
| None -> hub.SendAsync(HubMethod.StreamTo, asyncEnum)
|> Async.AwaitTask
member this.StreamToNow (asyncEnum: IAsyncEnumerable<'ClientStreamToApi>, ?cancellationToken: CancellationToken) =
this.StreamTo(asyncEnum, ?cancellationToken = cancellationToken)
|> Async.Start
// fsharplint:disable-next-line
type Hub<'ClientApi,'ServerApi> =
/// The connectionId to the hub of this client.
abstract ConnectionId : string option
/// Invokes a hub method on the server.
///
/// This method resolves when the server indicates it has finished invoking the method.
/// When it finishes, the server has finished invoking the method. If the server
/// method returns a result, it is produced as the result of resolving the async call.
abstract Invoke: msg: 'ClientApi -> Async<'ServerApi>
/// Default interval at which to ping the server.
///
/// The default value is 15,000 milliseconds (15 seconds).
/// Allows the server to detect hard disconnects (like when a client unplugs their computer).
abstract KeepAliveInterval : TimeSpan
/// Invokes a hub method on the server. Does not wait for a response from the receiver.
///
/// The async returned by this method resolves when the client has sent the invocation to the server.
/// The server may still be processing the invocation.
abstract Send: msg: 'ClientApi * ?cancellationToken: CancellationToken -> Async<unit>
/// Invokes a hub method on the server. Does not wait for a response from the receiver. The server may still
/// be processing the invocation.
abstract SendNow: msg: 'ClientApi * ?cancellationToken: CancellationToken -> unit
/// The server timeout in milliseconds.
///
/// If this timeout elapses without receiving any messages from the server, the connection will be
/// terminated with an error.
///
/// The default timeout value is 30,000 milliseconds (30 seconds).
abstract ServerTimeout : TimeSpan
/// The state of the hub connection to the server.
abstract State : HubConnectionState
[<RequireQualifiedAccess>]
module StreamHub =
// fsharplint:disable-next-line
type ClientToServer<'ClientApi,'ClientStreamApi,'ServerApi> =
inherit Hub<'ClientApi,'ServerApi>
/// Returns an asynchronous computation that when invoked, starts streaming to the hub.
abstract StreamTo: asyncEnum: IAsyncEnumerable<'ClientStreamApi> * ?cancellationToken: CancellationToken -> Async<unit>
/// Streams to the hub immediately.
abstract StreamToNow: asyncEnum: IAsyncEnumerable<'ClientStreamApi> * ?cancellationToken: CancellationToken -> unit
// fsharplint:disable-next-line
type ServerToClient<'ClientApi,'ClientStreamApi,'ServerApi,'ServerStreamApi> =
inherit Hub<'ClientApi,'ServerApi>
/// Streams from the hub.
abstract StreamFrom: msg: 'ClientStreamApi -> Async<IAsyncEnumerable<'ServerStreamApi>>
// fsharplint:disable-next-line
type Bidrectional<'ClientApi,'ClientStreamFromApi,'ClientStreamToApi,'ServerApi,'ServerStreamApi> =
inherit Hub<'ClientApi,'ServerApi>
inherit ClientToServer<'ClientApi,'ClientStreamToApi,'ServerApi>
inherit ServerToClient<'ClientApi,'ClientStreamFromApi,'ServerApi,'ServerStreamApi>
[<NoComparison;NoEquality>]
[<RequireQualifiedAccess>]
type internal HubMailbox<'ClientApi,'ServerApi> =
| ProcessSends
| Send of callback:(unit -> Async<unit>)
| ServerRsp of connectionId:string * invocationId: System.Guid * rsp:'ServerApi
| StartInvocation of msg:'ClientApi * replyChannel:AsyncReplyChannel<'ServerApi>
[<NoComparison;NoEquality>]
type internal Handlers =
{ OnClosed: (exn option -> Async<unit>) option
OnReconnected: (string option -> Async<unit>) option
OnReconnecting: (exn option -> Async<unit>) option }
member inline this.Apply (hub: IHubConnection<_,_,_,_,_>) =
Option.iter hub.OnClosed this.OnClosed
Option.iter hub.OnReconnected this.OnReconnected
Option.iter hub.OnReconnecting this.OnReconnecting
static member empty =
{ OnClosed = None
OnReconnecting = None
OnReconnected = None }
type HubConnection<'ClientApi,'ClientStreamFromApi,'ClientStreamToApi,'ServerApi,'ServerStreamApi>
internal (hub: IHubConnection<'ClientApi,'ClientStreamFromApi,'ClientStreamToApi,'ServerApi,'ServerStreamApi>, handlers: Handlers) =
let cts = new CancellationTokenSource()
let getLinkedCT (ct: CancellationToken option) =
match ct with
| None -> cts.Token
| Some ct -> CancellationTokenSource.CreateLinkedTokenSource(cts.Token, ct).Token
let processSends (pendingActions: (unit -> Async<unit>) list) =
async {
pendingActions
|> List.iter (fun a -> Async.StartImmediate(a(), cts.Token))
}
let mailbox =
MailboxProcessor.Start (fun inbox ->
let rec loop (waitingInvocations: Map<System.Guid,AsyncReplyChannel<'ServerApi>>) (waitingConnections: (unit -> Async<unit>) list) =
async {
let waitingConnections =
if hub.State = HubConnectionState.Connected then
processSends waitingConnections
|> fun a -> Async.Start(a, cts.Token)
[]
else waitingConnections
let! msg = inbox.Receive()
let hubId = hub.ConnectionId
return!
match msg with
| HubMailbox.ProcessSends ->
processSends waitingConnections
|> fun a -> Async.Start(a, cts.Token)
loop waitingInvocations []
| HubMailbox.Send action ->
let newConnections =
if hub.State = HubConnectionState.Connected then
action() |> fun a -> Async.Start(a, cts.Token)
[]
else [ action ]
loop waitingInvocations (newConnections @ waitingConnections)
| HubMailbox.ServerRsp (connectionId, invocationId, msg) ->
match hubId, connectionId, msg with
| Some hubId, connectionId, msg when hubId = connectionId ->
waitingInvocations.TryFind(invocationId)
|> Option.iter(fun reply -> reply.Reply(msg))
loop (waitingInvocations.Remove(invocationId)) waitingConnections
| _ -> loop waitingInvocations waitingConnections
| HubMailbox.StartInvocation (serverMsg, reply) ->
let newGuid = System.Guid.NewGuid()
let newConnections =
if hub.State = HubConnectionState.Connected then
hub.Invoke(serverMsg, newGuid, cts.Token) |> fun a -> Async.Start(a, cts.Token)
[]
else [ fun () -> hub.Invoke(serverMsg, newGuid, cts.Token) ]
loop (waitingInvocations.Add(newGuid, reply)) (newConnections @ waitingConnections)
}
loop Map.empty []
, cancellationToken = cts.Token)
let onRsp rsp =
async {
return
HubMailbox.ServerRsp (rsp.connectionId, rsp.invocationId, rsp.message)
|> mailbox.Post
}
|> Async.StartAsTask
|> genTask
let invokeHandler =
hub.Hub.On<InvokeArg<'ServerApi>>(HubMethod.Invoke, System.Func<_,_> onRsp)
do
{ handlers with
OnReconnected =
handlers.OnReconnected
|> Option.map(fun f ->
fun strOpt ->
mailbox.Post(HubMailbox.ProcessSends)
f strOpt)
|> Option.defaultValue (fun _ -> async { return mailbox.Post(HubMailbox.ProcessSends) })
|> Some }
|> fun handlers -> handlers.Apply(hub)
interface System.IDisposable with
member _.Dispose () =
async {
do! hub.Hub.DisposeAsync() |> Async.AwaitTask
do cts.Cancel()
do cts.Dispose()
return invokeHandler.Dispose()
}
|> Async.Start
interface Hub<'ClientApi,'ServerApi> with
member this.ConnectionId = this.ConnectionId
member this.Invoke msg = this.Invoke msg
member this.KeepAliveInterval = this.KeepAliveInterval
member this.Send (msg, ?ct) = this.Send(msg, ?cancellationToken = ct)
member this.SendNow (msg: 'ClientApi, ?ct) = this.SendNow(msg, ?cancellationToken = ct)
member this.ServerTimeout = this.ServerTimeout
member this.State = this.State
interface StreamHub.ClientToServer<'ClientApi,'ClientStreamToApi,'ServerApi> with
member this.StreamTo (asyncEnum, ?ct) = this.StreamTo(asyncEnum, ?cancellationToken = ct)
member this.StreamToNow (asyncEnum, ?ct) = this.StreamToNow(asyncEnum, ?cancellationToken = ct)
interface StreamHub.ServerToClient<'ClientApi,'ClientStreamFromApi,'ServerApi,'ServerStreamApi> with
member this.StreamFrom msg = this.StreamFrom msg
interface StreamHub.Bidrectional<'ClientApi,'ClientStreamFromApi,'ClientStreamToApi,'ServerApi,'ServerStreamApi>
/// The connectionId to the hub of this client.
member _.ConnectionId = hub.ConnectionId
/// Invokes a hub method on the server.
///
/// The async returned by this method resolves when the server indicates it has finished invoking
/// the method. When it finishes, the server has finished invoking the method. If the server
/// method returns a result, it is produced as the result of resolving the async call.
member _.Invoke (msg: 'ClientApi) =
mailbox.PostAndAsyncReply(fun reply -> HubMailbox.StartInvocation(msg, reply))
/// Default interval at which to ping the server.
///
/// The default value is 15,000 milliseconds (15 seconds).
/// Allows the server to detect hard disconnects (like when a client unplugs their computer).
member _.KeepAliveInterval = hub.KeepAliveInterval
/// Registers a handler that will be invoked when the connection is closed.
member _.OnClosed (callback: (exn option -> Async<unit>)) = hub.OnClosed(callback)
/// Callback when a new message is recieved.
member _.OnMessage (callback: 'ServerApi -> Async<unit>) = hub.OnMessage(callback)
/// Callback when the connection successfully reconnects.
member _.OnReconnected (callback: (string option -> Async<unit>)) = hub.OnReconnected(callback)
/// Callback when the connection starts reconnecting.
member _.OnReconnecting (callback: (exn option -> Async<unit>)) = hub.OnReconnecting(callback)
/// Invokes a hub method on the server. Does not wait for a response from the receiver.
///
/// The async returned by this method resolves when the client has sent the invocation to the server.
/// The server may still be processing the invocation.
member _.Send (msg: 'ClientApi, ?cancellationToken: CancellationToken) =
let ct = getLinkedCT cancellationToken
async { return mailbox.Post(HubMailbox.Send(fun () -> hub.Send(msg, ct))) }
/// Invokes a hub method on the server. Does not wait for a response from the receiver.
member this.SendNow (msg: 'ClientApi, ?cancellationToken: CancellationToken) =
let ct = getLinkedCT cancellationToken
this.Send(msg, ct)
|> fun a -> Async.Start(a, ct)
/// The server timeout in milliseconds.
///
/// If this timeout elapses without receiving any messages from the server, the connection will be
/// terminated with an error.
///
/// The default timeout value is 30,000 milliseconds (30 seconds).
member _.ServerTimeout = hub.ServerTimeout
/// Starts the connection.
member _.Start (?cancellationToken: CancellationToken) =
let ct = getLinkedCT cancellationToken
async {
if hub.State = HubConnectionState.Disconnected then
do! hub.Start(ct)
mailbox.Post(HubMailbox.ProcessSends)
}
/// Starts the connection immediately.
member this.StartNow (?cancellationToken: CancellationToken) =
let ct = getLinkedCT cancellationToken
this.Start(ct)
|> fun a -> Async.Start(a, ct)
/// The state of the hub connection to the server.
member _.State = hub.State
/// Stops the connection.
member _.Stop (?cancellationToken: CancellationToken) =
let ct = getLinkedCT cancellationToken
async {
if hub.State <> HubConnectionState.Disconnected then
do! hub.Stop(ct)
}
/// Stops the connection immediately.
member this.StopNow (?cancellationToken: CancellationToken) =
let ct = getLinkedCT cancellationToken
this.Stop(ct)
|> fun a -> Async.Start(a, ct)
/// Streams from the hub.
member _.StreamFrom (msg: 'ClientStreamFromApi) =
mailbox.PostAndAsyncReply <| fun reply ->
HubMailbox.Send <| fun () ->
async { return reply.Reply(hub.StreamFrom(msg)) }
/// Returns an async that when invoked, starts streaming to the hub.
member _.StreamTo (asyncEnum: IAsyncEnumerable<'ClientStreamToApi>, ?cancellationToken: CancellationToken) =
let ct = getLinkedCT cancellationToken
async { return mailbox.Post(HubMailbox.Send(fun () -> hub.StreamTo(asyncEnum, ct))) }
/// Streams to the hub immediately.
member this.StreamToNow (asyncEnum: IAsyncEnumerable<'ClientStreamToApi>, ?cancellationToken: CancellationToken) =
let ct = getLinkedCT cancellationToken
this.StreamTo(asyncEnum, ct)
|> fun a -> Async.StartImmediate(a, ct)

144
src/Fable.SignalR.DotNet/SignalR.fs Normal file
View File

@@ -0,0 +1,144 @@
namespace Fable.SignalR
open Fable.Remoting.Json
open Fable.SignalR.Shared
open Microsoft.AspNetCore.Http.Connections
open Microsoft.AspNetCore.Http.Connections.Client
open Microsoft.AspNetCore.SignalR.Client
open Microsoft.AspNetCore.SignalR.Protocol
open Microsoft.Extensions.Logging
open Microsoft.Extensions.DependencyInjection
open Newtonsoft.Json
open System
/// A builder for configuring HubConnection instances.
type HubConnectionBuilder<'ClientApi,'ClientStreamFromApi,'ClientStreamToApi,'ServerApi,'ServerStreamApi>
internal (hub: IHubConnectionBuilder) =
let mutable hub = hub
let mutable handlers = Handlers.empty
let mutable useMsgPack = false
/// Configures logging for the HubConnection.
member this.ConfigureLogging (f: ILoggingBuilder -> ILoggingBuilder) =
hub <- hub.ConfigureLogging(Action<ILoggingBuilder> (f >> ignore))
this
/// Callback when the connection is closed.
member this.OnClosed (callback: exn option -> Async<unit>) =
handlers <- { handlers with OnClosed = Some callback }
this
/// Callback when the connection successfully reconnects.
member this.OnReconnected (callback: string option -> Async<unit>) =
handlers <- { handlers with OnReconnected = Some callback }
this
/// Callback when the connection starts reconnecting.
member this.OnReconnecting (callback: exn option -> Async<unit>) =
handlers <- { handlers with OnReconnecting = Some callback }
this
/// Enable MessagePack binary (de)serialization instead of JSON.
member this.UseMessagePack () =
useMsgPack <- true
this
/// Configures the HubConnection to use HTTP-based transports to connect
/// to the specified URL.
///
/// The transport will be selected automatically based on what the server
/// and client support.
member this.WithUrl (url: string) =
hub <- hub.WithUrl(url)
this
/// Configures the HubConnection to use HTTP-based transports to connect
/// to the specified URL.
///
/// The transport will be selected automatically based on what the server
/// and client support.
member this.WithUrl (url: Uri) =
hub <- hub.WithUrl(url)
this
/// Configures the HubConnection to use the specified HTTP-based transport
/// to connect to the specified URL.
member this.WithUrl (url: string, transportType: HttpTransportType) =
hub <- hub.WithUrl(url, transportType)
this
/// Configures the HubConnection to use HTTP-based transports to connect to
/// the specified URL.
member this.WithUrl (url: string, options: HttpConnectionOptions -> unit) =
hub <- hub.WithUrl(url, options)
this
/// Configures the HubConnection to use HTTP-based transports to connect to
/// the specified URL.
member this.WithUrl (url: Uri, options: HttpConnectionOptions -> unit) =
hub <- hub.WithUrl(url, options)
this
/// Configures the HubConnection to use the specified Hub Protocol.
member this.WithServices (f: IServiceCollection -> unit) =
f hub.Services
this
/// Configures the HubConnection to use the specified Hub Protocol.
member this.WithServices (f: IServiceCollection -> IServiceCollection) =
f hub.Services |> ignore
this
/// Configures the HubConnection to automatically attempt to reconnect
/// if the connection is lost.
///
/// By default, the client will wait 0, 2, 10 and 30 seconds respectively
/// before trying up to 4 reconnect attempts.
member this.WithAutomaticReconnect () =
hub <- hub.WithAutomaticReconnect()
this
/// Configures the HubConnection to automatically attempt to reconnect if the
/// connection is lost.
///
/// An array containing the delays in milliseconds before trying each reconnect
/// attempt. The length of the array represents how many failed reconnect attempts
/// it takes before the client will stop attempting to reconnect.
member this.WithAutomaticReconnect (retryDelays: seq<TimeSpan>) =
hub <- hub.WithAutomaticReconnect(Array.ofSeq retryDelays)
this
/// Configures the HubConnection to automatically attempt to reconnect if the
/// connection is lost.
member this.WithAutomaticReconnect (reconnectPolicy: IRetryPolicy) =
hub <- hub.WithAutomaticReconnect(reconnectPolicy)
this
member internal _.Build () =
if useMsgPack then
hub.Services.AddSingleton<IHubProtocol,MsgPackProtocol.FableHubProtocol<'ClientApi,'ClientStreamFromApi,'ClientStreamToApi,'ServerApi,'ServerStreamApi>>()
|> ignore
hub
else
hub.AddNewtonsoftJsonProtocol(fun o ->
o.PayloadSerializerSettings.DateParseHandling <- DateParseHandling.None
o.PayloadSerializerSettings.ContractResolver <- new Serialization.DefaultContractResolver()
o.PayloadSerializerSettings.Converters.Add(FableJsonConverter()))
|> fun hub -> IHubConnection<'ClientApi,'ClientStreamFromApi,'ClientStreamToApi,'ServerApi,'ServerStreamApi>(hub.Build())
|> fun hub -> new HubConnection<'ClientApi,'ClientStreamFromApi,'ClientStreamToApi,'ServerApi,'ServerStreamApi>(hub, handlers)
type SignalR =
/// Starts a connection to a SignalR hub.
static member Connect<'ClientApi,'ClientStreamFromApi,'ClientStreamToApi,'ServerApi,'ServerStreamApi>
(config: HubConnectionBuilder<'ClientApi,'ClientStreamFromApi,'ClientStreamToApi,'ServerApi,'ServerStreamApi>
-> HubConnectionBuilder<'ClientApi,'ClientStreamFromApi,'ClientStreamToApi,'ServerApi,'ServerStreamApi>) =
HubConnectionBuilder<'ClientApi,'ClientStreamFromApi,'ClientStreamToApi,'ServerApi,'ServerStreamApi>(HubConnectionBuilder())
|> config
|> fun hubBuilder -> hubBuilder.Build()
[<assembly:System.Runtime.CompilerServices.InternalsVisibleTo("Fable.SignalR.DotNet.Elmish")>]
do ()

6
src/Fable.SignalR.DotNet/paket.references Normal file
View File

@@ -0,0 +1,6 @@
group Fable.SignalR.DotNet
Fable.Remoting.Json
Fable.Remoting.MsgPack
FSharp.Core
Microsoft.AspNetCore.SignalR.Client
Microsoft.AspNetCore.SignalR.Protocols.NewtonsoftJson

8
src/Fable.SignalR.DotNet/paket.template Normal file
View File

@@ -0,0 +1,8 @@
type project
authors Cody Johnson
description
A type-safe functional wrapper for SignalR and .NET clients
language
F#
tags
fsharp, fable, websocket, signalr, dotnet, client

13
src/Fable.SignalR.Elmish/Elmish.fs
View File

@@ -352,14 +352,14 @@ module Elmish =
| Some hub ->
Cmd.OfAsyncWith.attempt
(fun msg -> Async.StartImmediate(msg, hub.cts.Token))
(fun msg -> hub.hub.invoke msg)
hub.hub.invoke
msg
onError
| None ->
#if DEBUG
JS.console.error("Cannot send a message if hub is not initialized!")
#endif
[ fun _ -> () ]
[ ignore ]
/// Invokes a hub method on the server and maps the success or error.
///
@@ -371,7 +371,7 @@ module Elmish =
| Some hub ->
Cmd.OfAsyncWith.either
(fun msg -> Async.StartImmediate(msg, hub.cts.Token))
(fun msg -> hub.hub.invoke msg)
hub.hub.invoke
msg
onSuccess
onError
@@ -379,7 +379,7 @@ module Elmish =
#if DEBUG
JS.console.error("Cannot send a message if hub is not initialized!")
#endif
[ fun _ -> () ]
[ ignore ]
/// Invokes a hub method on the server and maps the success.
///
@@ -391,14 +391,14 @@ module Elmish =
| Some hub ->
Cmd.OfAsyncWith.perform
(fun msg -> Async.StartImmediate(msg, hub.cts.Token))
(fun msg -> hub.hub.invoke msg)
hub.hub.invoke
msg
onSuccess
| None ->
#if DEBUG
JS.console.error("Cannot send a message if hub is not initialized!")
#endif
[ fun _ -> () ]
[ ignore ]
/// Invokes a hub method on the server. Does not wait for a response from the receiver.
///
@@ -443,6 +443,7 @@ module Elmish =
static member inline streamTo (hub: Elmish.StreamHub.ClientToServer<'ClientApi,'ClientStreamToApi,'ServerApi> option) =
fun (subject: #ISubject<'ClientStreamToApi>) ->
[ fun _ -> hub |> Option.iter (fun hub -> hub.hub.streamToNow(subject)) ] : Cmd<_>
/// Streams to the hub.
static member inline streamTo (hub: Elmish.StreamHub.Bidrectional<'ClientApi,_,'ClientStreamToApi,'ServerApi,_> option) =
fun (subject: #ISubject<'ClientStreamToApi>) ->

17
src/Fable.SignalR.Shared/Fable.SignalR.Shared.fsproj Normal file
View File

@@ -0,0 +1,17 @@
<?xml version="1.0" encoding="utf-8"?>
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<OutputType>Library</OutputType>
<TargetFramework>netcoreapp3.1</TargetFramework>
</PropertyGroup>
<ItemGroup>
<Compile Include="Types.fs" />
<Compile Include="MemoryCache.fs" />
<Compile Include="MsgPack.fs" />
<None Include="paket.references" />
</ItemGroup>
<ItemGroup Condition=" '$(TargetFramework)' == 'netcoreapp3.1' ">
<FrameworkReference Include="Microsoft.AspNetCore.App" />
</ItemGroup>
<Import Project="..\..\.paket\Paket.Restore.targets" />
</Project>

2
src/Fable.SignalR.AspNetCore/MemoryCache.fs → src/Fable.SignalR.Shared/MemoryCache.fs
View File

@@ -1,4 +1,4 @@
namespace Fable.SignalR
namespace Fable.SignalR.Shared
module internal MemoryCache =
open FSharp.Control

4
src/Fable.SignalR.AspNetCore/MsgPack.fs → src/Fable.SignalR.Shared/MsgPack.fs
View File

@@ -1,4 +1,4 @@
namespace Fable.SignalR
namespace Fable.SignalR.Shared
open Fable.Remoting.MsgPack
open Microsoft.AspNetCore.SignalR
@@ -9,7 +9,7 @@ open System.IO
open System.Buffers
[<RequireQualifiedAccess>]
module internal MsgPackProtocol =
module MsgPackProtocol =
open Fable.SignalR.Shared
open Fable.SignalR.Shared.MsgPack

0
src/Fable.SignalR.AspNetCore/Shared.fs → src/Fable.SignalR.Shared/Types.fs
View File

5
src/Fable.SignalR.Shared/paket.references Normal file
View File

@@ -0,0 +1,5 @@
group Fable.SignalR.Shared
Fable.Remoting.Json
Fable.Remoting.MsgPack
FSharp.Core
Microsoft.AspNetCore.SignalR.Protocols.NewtonsoftJson

8
src/Fable.SignalR/HubConnection.fs
View File

@@ -495,7 +495,7 @@ type HubConnection<'ClientApi,'ClientStreamFromApi,'ClientStreamToApi,'ServerApi
let! msg = inbox.Receive()
let hubId = hub.connectionId
let hubId = hub.connectionId
return!
match msg with
@@ -512,7 +512,7 @@ type HubConnection<'ClientApi,'ClientStreamFromApi,'ClientStreamToApi,'ServerApi
else [ action ]
loop waitingInvocations (newConnections @ waitingConnections)
| HubMailbox.ServerRsp(connectionId, invocationId, msg) ->
| HubMailbox.ServerRsp (connectionId, invocationId, msg) ->
match hubId,connectionId, msg with
| Some hubId, connectionId, msg when hubId = connectionId ->
waitingInvocations.TryFind(invocationId)
@@ -520,7 +520,7 @@ type HubConnection<'ClientApi,'ClientStreamFromApi,'ClientStreamToApi,'ServerApi
loop (waitingInvocations.Remove(invocationId)) waitingConnections
| _ -> loop waitingInvocations waitingConnections
| HubMailbox.StartInvocation(serverMsg, reply) ->
| HubMailbox.StartInvocation (serverMsg, reply) ->
let newGuid = System.Guid.NewGuid()
let newConnections =
@@ -547,7 +547,7 @@ type HubConnection<'ClientApi,'ClientStreamFromApi,'ClientStreamToApi,'ServerApi
|> Option.defaultValue (fun _ -> mailbox.Post(HubMailbox.ProcessSends))
|> Some }
|> fun handlers -> handlers.apply(hub)
hub.on<InvokeArg<'ServerApi>>("Invoke", fun rsp -> onRsp(rsp.connectionId,rsp.invocationId,rsp.message))
hub.on<InvokeArg<'ServerApi>>("Invoke", fun rsp -> onRsp(rsp.connectionId, rsp.invocationId, rsp.message))
interface System.IDisposable with
member _.Dispose () =

6
src/Fable.SignalR/SignalR.fs
View File

@@ -25,7 +25,7 @@ type HubConnectionBuilder<'ClientApi,'ClientStreamFromApi,'ClientStreamToApi,'Se
this
/// Callback when the connection is closed.
member this.onClose callback =
member this.onClose (callback: exn option -> unit) =
handlers <- { handlers with onClose = Some callback }
this
@@ -35,12 +35,12 @@ type HubConnectionBuilder<'ClientApi,'ClientStreamFromApi,'ClientStreamToApi,'Se
this
/// Callback when the connection successfully reconnects.
member this.onReconnected (callback: (string option -> unit)) =
member this.onReconnected (callback: string option -> unit) =
handlers <- { handlers with onReconnected = Some callback }
this
/// Callback when the connection starts reconnecting.
member this.onReconnecting (callback: (exn option -> unit)) =
member this.onReconnecting (callback: exn option -> unit) =
handlers <- { handlers with onReconnecting = Some callback }
this

21
tests/Fable.SignalR.DotNet.Tests/Client.fs Normal file
View File

@@ -0,0 +1,21 @@
namespace Fable.SignalR.DotNet.Tests
module Client =
open Expecto
open Microsoft.AspNetCore.TestHost
open Microsoft.Extensions.Hosting
let host =
SignalRApp.App.app
.ConfigureWebHost(fun webBuilder -> webBuilder.UseTestServer() |> ignore)
.StartAsync()
|> Async.AwaitTask
|> Async.RunSynchronously
let testServer = host.GetTestServer()
[<Tests>]
let tests = testList "Client" [
testPropertyP "DotNet SignalR client works" <| Generation.Commands.commandGen testServer
testPropertyP "DotNet SignalR client works with MsgPack" <| Generation.Commands.msgPackCommandGen testServer
]

10
tests/Fable.SignalR.DotNet.Tests/Config.fs Normal file
View File

@@ -0,0 +1,10 @@
namespace Fable.SignalR.DotNet.Tests
[<AutoOpen>]
module Config =
open Expecto
let config =
{ FsCheckConfig.defaultConfig with maxTest = 100 }
let inline testProp name f = testPropertyWithConfig config name f

102
tests/Fable.SignalR.DotNet.Tests/Extensions.fs Normal file
View File

@@ -0,0 +1,102 @@
namespace Fable.SignalR.DotNet.Tests
[<AutoOpen>]
module TestProperty =
open Expecto
open FsCheck
open System
let private propertyTest methodName focusState configs name (property: Property) =
let runner (config: FsCheckConfig) =
{ new IRunner with
member __.OnStartFixture _ = ()
member __.OnArguments(testNumber, args, formatOnEvery) =
config.receivedArgs config name testNumber args
|> Async.RunSynchronously
member __.OnShrink(values, formatValues) =
config.successfulShrink config name values
|> Async.RunSynchronously
member __.OnFinished(fsCheckTestName, testResult) =
config.finishedTest config fsCheckTestName
|> Async.RunSynchronously
let numTests i =
if i = 1 then "1 test" else sprintf "%i tests" i
let stampsToString s =
let entry (p, xs) =
sprintf "%A%s %s" p "%" (String.concat ", " xs)
match Seq.map entry s |> Seq.toList with
| [] -> ""
| [ x ] -> sprintf " (%s)\n" x
| xs -> sprintf "%s\n" (String.concat "\n" xs)
match testResult with
| TestResult.True (_testData, _b) -> ()
| TestResult.False (_, _, _, Outcome.Exception (:? IgnoreException as e), _) -> raise e
| TestResult.False (data, original, shrunk, outcome, Random.StdGen (std, gen)) ->
let parameters =
original
|> List.map (sprintf "%A")
|> String.concat " "
|> sprintf "Parameters:\n\t%s"
let shrunk =
if data.NumberOfShrinks > 0 then
shrunk
|> List.map (sprintf "%A")
|> String.concat " "
|> sprintf "\nShrunk %i times to:\n\t%s" data.NumberOfShrinks
else
""
let labels =
match data.Labels.Count with
| 0 -> String.Empty
| 1 -> sprintf "Label of failing property: %s\n" (Set.toSeq data.Labels |> Seq.head)
| _ ->
sprintf "Labels of failing property (one or more is failing): %s\n"
(String.concat " " data.Labels)
let focus =
sprintf "Focus on error:\n\t%s (%i, %i) \"%s\"" methodName std gen name
sprintf "Failed after %s. %s%s\nResult:\n\t%A\n%s%s%s" (numTests data.NumberOfTests) parameters
shrunk outcome labels (stampsToString data.Stamps) focus
|> FailedException
|> raise
| TestResult.Exhausted data ->
sprintf "Exhausted after %s%s" (numTests data.NumberOfTests) (stampsToString data.Stamps)
|> FailedException
|> raise }
let test (config: FsCheckConfig) =
let config =
{ MaxTest = config.maxTest
MaxFail = 1000
Replay = Option.map Random.StdGen config.replay
Name = name
StartSize = config.startSize
EndSize = config.endSize
QuietOnSuccess = true
Every = fun _ _ -> String.Empty
EveryShrink = fun _ -> String.Empty
Arbitrary = config.arbitrary
Runner = runner config }
Check.One(config, property) |> async.Return
let testCode =
match configs with
| None -> AsyncFsCheck(None, None, test)
| Some (testConfig, stressConfig) -> AsyncFsCheck(Some testConfig, Some stressConfig, test)
TestLabel(name, TestCase(testCode, focusState), focusState)
let testPropertyP name =
propertyTest "etestProperty" Normal None name

27
tests/Fable.SignalR.DotNet.Tests/Fable.SignalR.DotNet.Tests.fsproj Normal file
View File

@@ -0,0 +1,27 @@
<?xml version="1.0" encoding="utf-8"?>
<Project Sdk="Microsoft.NET.Sdk">
<PropertyGroup>
<OutputType>Exe</OutputType>
<TargetFramework>netcoreapp3.1</TargetFramework>
<ServerGarbageCollection>true</ServerGarbageCollection>
</PropertyGroup>
<PropertyGroup Condition="'$(Configuration)|$(TargetFramework)|$(Platform)'=='Debug|netcoreapp3.1|AnyCPU'">
<PlatformTarget>x64</PlatformTarget>
</PropertyGroup>
<ItemGroup>
<Compile Include="Util.fs" />
<Compile Include="Extensions.fs" />
<Compile Include="Generation.fs" />
<Compile Include="Config.fs" />
<Compile Include="Client.fs" />
<Compile Include="RunTests.fs" />
<None Include="paket.references" />
</ItemGroup>
<ItemGroup>
<ProjectReference Include="..\..\src\Fable.SignalR.DotNet.Elmish\Fable.SignalR.DotNet.Elmish.fsproj" />
<ProjectReference Include="..\..\src\Fable.SignalR.DotNet\Fable.SignalR.DotNet.fsproj" />
<ProjectReference Include="..\Fable.SignalR.TestServer\Fable.SignalR.TestServer.fsproj" />
<ProjectReference Include="..\Fable.SignalR.TestShared\Fable.SignalR.TestShared.fsproj" />
</ItemGroup>
<Import Project="..\..\.paket\Paket.Restore.targets" />
</Project>

399
tests/Fable.SignalR.DotNet.Tests/Generation.fs Normal file
View File

@@ -0,0 +1,399 @@
namespace Fable.SignalR.DotNet.Tests
module Generation =
open FsCheck
open Microsoft.AspNetCore.TestHost
module Model =
open Fable.SignalR
open FSharp.Control
open Microsoft.AspNetCore.SignalR.Client
open Microsoft.Extensions.Logging
open SignalRApp
open SignalRApp.SignalRHub
[<RequireQualifiedAccess>]
type StreamStatus =
| NotStarted
| Error of exn option
| Streaming
| Finished
type Model =
{ Count: int
Text: string
SFCount: int
StreamState: StreamStatus
StreamToState: StreamStatus }
static member empty =
{ Count = 0
Text = ""
SFCount = 0
StreamState = StreamStatus.NotStarted
StreamToState = StreamStatus.NotStarted }
type Msg =
| ServerMsg of Response
| ServerStreamMsg of StreamFrom.Response
| SetStreamState of StreamStatus
| SetClientStreamState of StreamStatus
| GetState of (Model -> bool) * AsyncReplyChannel<Model>
| SetState of (Model -> Model)
type Hub = HubConnection<Action,StreamFrom.Action,StreamTo.Action,Response,StreamFrom.Response>
let hub (server: TestServer) : Hub =
SignalR.Connect<Action,StreamFrom.Action,StreamTo.Action,Response,StreamFrom.Response>(fun hub ->
hub.WithUrl("http://localhost:8085" + Endpoints.Root, fun o -> o.HttpMessageHandlerFactory <- (fun _ -> server.CreateHandler()))
.WithAutomaticReconnect()
.ConfigureLogging(fun logBuilder -> logBuilder.SetMinimumLevel(LogLevel.None)))
let msgPackHub (server: TestServer) : Hub =
SignalR.Connect<Action,StreamFrom.Action,StreamTo.Action,Response,StreamFrom.Response>(fun hub ->
hub.WithUrl("http://localhost:8085" + Endpoints.Root2, fun o -> o.HttpMessageHandlerFactory <- (fun _ -> server.CreateHandler()))
.WithAutomaticReconnect()
.ConfigureLogging(fun logBuilder -> logBuilder.SetMinimumLevel(LogLevel.None)))
type HubModel (hub: Hub) =
let replyIfNew newState (waiting: ((Model -> bool) * AsyncReplyChannel<Model>) list) =
waiting
|> List.choose (fun (pred,reply) ->
if pred newState then
reply.Reply newState
None
else Some(pred,reply))
let mailbox =
MailboxProcessor.Start <| fun inbox ->
let rec loop (state: Model) (waitingState: ((Model -> bool) * AsyncReplyChannel<Model>) list) =
async {
let! msg = inbox.Receive()
return!
match msg with
| ServerMsg msg ->
match msg with
| Response.NewCount i -> { state with Count = i }
| Response.RandomCharacter str -> { state with Text = str }
|> fun newState ->
replyIfNew newState waitingState
|> loop newState
| ServerStreamMsg msg ->
match msg with
| StreamFrom.Response.GetInts i ->
let newState = { state with SFCount = i }
replyIfNew newState waitingState
|> loop newState
| SetStreamState streamState ->
loop { state with StreamState = streamState } waitingState
| SetClientStreamState streamState ->
loop { state with StreamToState = streamState } waitingState
| GetState (pred,reply) ->
if pred state then
reply.Reply(state)
waitingState
else (pred,reply)::waitingState
|> loop state
| SetState newState ->
let newState = newState state
replyIfNew newState waitingState
|> loop newState
}
loop {
Count = 0
Text = ""
SFCount = 0
StreamState = StreamStatus.NotStarted
StreamToState = StreamStatus.NotStarted
} []
let _ = hub.OnMessage (ServerMsg >> mailbox.Post >> Async.lift)
member _.IsConnected () =
async {
if hub.State = HubConnectionState.Disconnected then
do! hub.Start()
return hub.State = HubConnectionState.Connected
}
member _.GetState (predicate: Model -> bool) =
mailbox.PostAndAsyncReply(fun reply -> GetState(predicate,reply))
member this.SendIncrement () =
async {
let! initState = this.GetState(fun _ -> true)
let initCount = initState.Count
do!
Action.IncrementCount initCount
|> hub.Send
return! this.GetState(fun m -> m.Count <> initCount)
}
member this.SendDecrement () =
async {
let! initState = this.GetState(fun _ -> true)
let initCount = initState.Count
do!
Action.DecrementCount initCount
|> hub.Send
return! this.GetState(fun m -> m.Count <> initCount)
}
member this.InvokeIncrement () =
async {
let! initState = this.GetState(fun _ -> true)
match! Action.IncrementCount initState.Count |> hub.Invoke with
| Response.NewCount i -> mailbox.Post(SetState(fun m -> { m with Count = i }))
| _ -> ()
return! this.GetState(fun _ -> true)
}
member this.InvokeDecrement () =
async {
let! initState = this.GetState(fun _ -> true)
match! Action.DecrementCount initState.Count |> hub.Invoke with
| Response.NewCount i -> mailbox.Post(SetState(fun m -> { m with Count = i }))
| _ -> ()
return! this.GetState(fun _ -> true)
}
member this.StreamFrom () =
async {
mailbox.Post (SetStreamState StreamStatus.Streaming)
try
let! stream = hub.StreamFrom StreamFrom.Action.GenInts
do!
stream
|> AsyncSeq.ofAsyncEnum
|> AsyncSeq.iter (fun msg ->
match msg with
| StreamFrom.Response.GetInts i ->
mailbox.Post(SetState(fun m -> { m with SFCount = m.SFCount + i }))
)
mailbox.Post(SetState(fun m -> { m with StreamState = StreamStatus.Finished }))
with e -> mailbox.Post(SetState(fun m -> { m with StreamState = StreamStatus.Error (Some e) }))
return! this.GetState(fun m -> m.StreamState = StreamStatus.Finished)
}
member this.StreamTo () =
async {
mailbox.Post (SetClientStreamState StreamStatus.Streaming)
try
let stream =
asyncSeq {
for i in [1..100] do
yield StreamTo.Action.GiveInt i
}
|> AsyncSeq.toAsyncEnum
do! hub.StreamTo stream
mailbox.Post (SetClientStreamState StreamStatus.Finished)
with e -> mailbox.Post (SetClientStreamState <| StreamStatus.Error(Some e))
return! this.GetState(fun m -> m.StreamState <> StreamStatus.Streaming)
}
module Commands =
type SendIncrement () =
inherit Command<Model.HubModel, Model.Model>()
override _.RunActual hm =
hm.SendIncrement()
|> Async.Ignore
|> Async.RunSynchronously
hm
override _.RunModel m = { m with Count = m.Count + 1 }
override _.Post (hm, m) =
async {
let! actual = hm.GetState(fun _ -> true)
return actual = m |@ sprintf "model: %A <> %A" actual m
}
|> Async.RunSynchronously
override _.ToString() = "Send Increment"
type SendDecrement () =
inherit Command<Model.HubModel, Model.Model>()
override _.RunActual hm =
hm.SendDecrement()
|> Async.Ignore
|> Async.RunSynchronously
hm
override _.RunModel m = { m with Count = m.Count - 1 }
override _.Post (hm, m) =
async {
let! actual = hm.GetState(fun _ -> true)
return actual = m |@ sprintf "model: %A <> %A" actual m
}
|> Async.RunSynchronously
override _.ToString() = "Send Decrement"
type InvokeIncrement () =
inherit Command<Model.HubModel, Model.Model>()
override _.RunActual hm =
hm.InvokeIncrement()
|> Async.Ignore
|> Async.RunSynchronously
hm
override _.RunModel m = { m with Count = m.Count + 1 }
override _.Post (hm, m) =
async {
let! actual = hm.GetState(fun _ -> true)
return actual = m |@ sprintf "model: %A <> %A" actual m
}
|> Async.RunSynchronously
override _.ToString() = "Invoke Increment"
type InvokeDecrement () =
inherit Command<Model.HubModel, Model.Model>()
override _.RunActual hm =
hm.InvokeDecrement()
|> Async.Ignore
|> Async.RunSynchronously
hm
override _.RunModel m = { m with Count = m.Count - 1 }
override _.Post (hm, m) =
async {
let! actual = hm.GetState(fun _ -> true)
return actual = m |@ sprintf "model: %A <> %A" actual m
}
|> Async.RunSynchronously
override _.ToString() = "Invoke Decrement"
type StreamFrom () =
inherit Command<Model.HubModel, Model.Model>()
override _.RunActual hm =
hm.StreamFrom()
|> Async.Ignore
|> Async.RunSynchronously
hm
override _.RunModel m =
{ m with
SFCount = m.SFCount + 55
StreamState = Model.StreamStatus.Finished }
override _.Post (hm, m) =
async {
let! actual = hm.GetState(fun _ -> true)
return actual = m |@ sprintf "model: %A <> %A" actual m
}
|> Async.RunSynchronously
override _.ToString() = "Stream From"
type StreamTo () =
inherit Command<Model.HubModel, Model.Model>()
override _.RunActual hm =
hm.StreamTo()
|> Async.Ignore
|> Async.RunSynchronously
hm
override _.RunModel m = { m with StreamToState = Model.StreamStatus.Finished }
override _.Post (hm, m) =
async {
let! actual = hm.GetState(fun _ -> true)
return actual = m |@ sprintf "model: %A <> %A" actual m
}
|> Async.RunSynchronously
override _.ToString() = "Stream To"
let commandGen (server: TestServer) =
{ new ICommandGenerator<Model.HubModel, Model.Model> with
member _.InitialActual =
let actual = Model.HubModel(Model.hub server)
actual.IsConnected()
|> Async.RunSynchronously
|> function
| true -> ()
| false -> failwith "Hub not running"
actual
member _.InitialModel = Model.Model.empty
member _.Next _ =
Gen.elements [
SendIncrement()
SendDecrement()
InvokeIncrement()
InvokeDecrement()
StreamFrom()
StreamTo()
] }
|> Command.toProperty
let msgPackCommandGen (server: TestServer) =
{ new ICommandGenerator<Model.HubModel, Model.Model> with
member _.InitialActual =
let actual = Model.HubModel(Model.msgPackHub server)
actual.IsConnected()
|> Async.RunSynchronously
|> function
| true -> ()
| false -> failwith "Hub not running"
actual
member _.InitialModel = Model.Model.empty
member _.Next _ =
Gen.elements [
SendIncrement()
SendDecrement()
InvokeIncrement()
InvokeDecrement()
StreamFrom()
StreamTo()
] }
|> Command.toProperty

11
tests/Fable.SignalR.DotNet.Tests/RunTests.fs Normal file
View File

@@ -0,0 +1,11 @@
namespace Fable.SignalR.DotNet.Tests
open Expecto
module RunTests =
[<EntryPoint>]
let main _ =
Tests.runTests defaultConfig Client.tests
|> fun i ->
Client.host.Dispose()
i

9
tests/Fable.SignalR.DotNet.Tests/Util.fs Normal file
View File

@@ -0,0 +1,9 @@
namespace Fable.SignalR.DotNet.Tests
[<AutoOpen>]
module Util =
open Expecto
[<RequireQualifiedAccess>]
module Async =
let lift x = async { return x }

6
tests/Fable.SignalR.DotNet.Tests/paket.references Normal file
View File

@@ -0,0 +1,6 @@
group Fable.SignalR.DotNet.Tests
Expecto
Expecto.FsCheck
FSharp.Control.AsyncSeq
FSharp.Core
Microsoft.AspNetCore.TestHost

79
tests/Fable.SignalR.TestServer/App.fs
View File

@@ -7,48 +7,49 @@ module App =
open Saturn
open System
let app =
application {
use_signalr (
configure_signalr {
endpoint Endpoints.Root
send SignalRHub.send
invoke SignalRHub.invoke
stream_from SignalRHub.Stream.sendToClient
stream_to SignalRHub.Stream.getFromClient
with_log_level Microsoft.Extensions.Logging.LogLevel.None
with_hub_options (fun ho -> ho.EnableDetailedErrors <- Nullable<bool>(true))
}
)
use_signalr (
configure_signalr {
endpoint Endpoints.Root2
send SignalRHub2.send
invoke SignalRHub2.invoke
stream_from SignalRHub2.Stream.sendToClient
stream_to SignalRHub2.Stream.getFromClient
with_log_level Microsoft.Extensions.Logging.LogLevel.None
with_hub_options (fun ho -> ho.EnableDetailedErrors <- Nullable<bool>(true))
use_messagepack
}
)
service_config (fun s -> s.AddSingleton<RandomStringGen>())
logging (fun l -> l.AddFilter("Microsoft", LogLevel.Error) |> ignore)
url (sprintf "http://localhost:%i/" <| Env.getPortsOrDefault 8085us)
use_cors "Any" (fun policy ->
policy
.WithOrigins("http://localhost", "http://127.0.0.1:80")
.AllowAnyHeader()
.AllowAnyMethod()
.AllowCredentials()
|> ignore
)
no_router
use_developer_exceptions
}
[<EntryPoint>]
let main _ =
try
let app =
application {
use_signalr (
configure_signalr {
endpoint Endpoints.Root
send SignalRHub.send
invoke SignalRHub.invoke
stream_from SignalRHub.Stream.sendToClient
stream_to SignalRHub.Stream.getFromClient
with_log_level Microsoft.Extensions.Logging.LogLevel.None
with_hub_options (fun ho -> ho.EnableDetailedErrors <- Nullable<bool>(true))
}
)
use_signalr (
configure_signalr {
endpoint Endpoints.Root2
send SignalRHub2.send
invoke SignalRHub2.invoke
stream_from SignalRHub2.Stream.sendToClient
stream_to SignalRHub2.Stream.getFromClient
with_log_level Microsoft.Extensions.Logging.LogLevel.None
with_hub_options (fun ho -> ho.EnableDetailedErrors <- Nullable<bool>(true))
use_messagepack
}
)
service_config (fun s -> s.AddSingleton<RandomStringGen>())
logging (fun l -> l.AddFilter("Microsoft", LogLevel.Error) |> ignore)
url (sprintf "http://0.0.0.0:%i/" <| Env.getPortsOrDefault 8085us)
use_cors "Any" (fun policy ->
policy
.WithOrigins("http://localhost", "http://127.0.0.1:80")
.AllowAnyHeader()
.AllowAnyMethod()
.AllowCredentials()
|> ignore
)
no_router
use_developer_exceptions
}
printfn "Working directory - %s" (System.IO.Directory.GetCurrentDirectory())
run app
0 // return an integer exit code

13
tests/Fable.SignalR.Tests/SignalR.test.fs
View File

@@ -28,7 +28,6 @@ type Msg =
| SetClientStreamState of StreamStatus
| GetState of (Model -> bool) * AsyncReplyChannel<Model>
| SetState of (Model -> Model)
| IsConnected of AsyncReplyChannel<bool>
type Hub = HubConnection<Action,StreamFrom.Action,StreamTo.Action,Response,StreamFrom.Response>
@@ -90,18 +89,6 @@ type HubModel (hub: Hub) =
replyIfNew newState waitingState
|> loop newState
| IsConnected reply ->
async {
if hub.state = ConnectionState.Disconnected then
do! hub.start()
while hub.state <> ConnectionState.Connected do
do! Async.Sleep 10
do reply.Reply(hub.state = ConnectionState.Connected)
return! loop state waitingState
}
}
loop {