New XMPP client

Emulsion.Tests/Emulsion.Tests.fsproj

@@ -7,17 +7,22 @@
     <Compile Include="TestUtils\LockedBuffer.fs" />
     <Compile Include="TestUtils\Logging.fs" />
     <Compile Include="TestUtils\Waiter.fs" />
-    <Compile Include="Settings.fs" />
+    <Compile Include="ExceptionUtilsTests.fs" />
+    <Compile Include="LifetimesTests.fs" />
     <Compile Include="MessageSenderTests.fs" />
+    <Compile Include="SettingsTests.fs" />
     <Compile Include="Actors/Core.fs" />
     <Compile Include="Actors/Telegram.fs" />
     <Compile Include="Actors/Xmpp.fs" />
     <Compile Include="MessageSystemTests\WrapRunTests.fs" />
     <Compile Include="MessageSystemTests\MessageSystemBaseTests.fs" />
     <Compile Include="Telegram\Html.fs" />
     <Compile Include="Telegram\FunogramTests.fs" />
+    <Compile Include="Xmpp\XmppClientFactory.fs" />
     <Compile Include="Xmpp\XmppMessageFactory.fs" />
-    <Compile Include="Xmpp\SharpXmppHelper.fs" />
+    <Compile Include="Xmpp\XmppClientTests.fs" />
+    <Compile Include="Xmpp\SharpXmppHelperTests.fs" />
+    <Compile Include="Xmpp\EmulsionXmppTests.fs" />
   </ItemGroup>
   <ItemGroup>
     <PackageReference Include="Akka.TestKit" Version="1.3.12" />

Emulsion.Tests/ExceptionUtilsTests.fs

@@ -0,0 +1,35 @@
+module Emulsion.Tests.ExceptionUtilsTests
+
+open System
+
+open Emulsion
+open Xunit
+
+[<Fact>]
+let ``reraise works in sync code``(): unit =
+    let nestedStacktrace() =
+        raise <| Exception("Foo")
+    let thrown =
+        try
+            nestedStacktrace()
+            null
+        with
+        | ex -> ex
+    let rethrown = Assert.Throws<Exception>(fun () -> ExceptionUtils.reraise thrown |> ignore)
+    Assert.Contains("nestedStacktrace", rethrown.StackTrace)
+
+[<Fact>]
+let ``reraise works in async code``(): unit =
+    let nestedStacktrace() =
+        raise <| Exception("Foo")
+
+    let ex = Assert.Throws<Exception>(fun () ->
+        async {
+            try
+                nestedStacktrace()
+            with
+            | ex ->
+                ExceptionUtils.reraise ex
+        } |> Async.RunSynchronously
+    )
+    Assert.Contains("nestedStacktrace", ex.StackTrace)

Emulsion.Tests/LifetimesTests.fs

@@ -0,0 +1,16 @@
+module Emulsion.Tests.LifetimesTests
+
+open JetBrains.Lifetimes
+
+open Xunit
+
+open System.Threading.Tasks
+open Emulsion.Lifetimes
+
+[<Fact>]
+let ``awaitTermination completes after the parent lifetime is terminated``(): unit =
+    use ld = Lifetime.Define()
+    let task = Async.StartAsTask <| awaitTermination ld.Lifetime
+    Assert.False task.IsCompleted
+    ld.Terminate()
+    task.GetAwaiter().GetResult() |> ignore

Emulsion.Tests/Settings.fs → Emulsion.Tests/SettingsTests.fs

@@ -1,4 +1,4 @@
-module Emulsion.Tests.Settings
+module Emulsion.Tests.SettingsTests
 
 open System
 open System.IO

Emulsion.Tests/Xmpp/EmulsionXmppTests.fs

@@ -0,0 +1,170 @@
+module Emulsion.Tests.Xmpp.EmulsionXmppTests
+
+open System
+open System.Threading.Tasks
+
+open JetBrains.Lifetimes
+open SharpXMPP
+open Xunit
+open Xunit.Abstractions
+
+open Emulsion.Settings
+open Emulsion
+open Emulsion.Lifetimes
+open Emulsion.Tests.TestUtils
+open Emulsion.Tests.Xmpp
+open Emulsion.Xmpp
+open Emulsion.Xmpp.SharpXmppHelper.Elements
+
+let private settings = {
+    Login = "user@example.org"
+    Password = "password"
+    Room = "room@conference.example.org"
+    Nickname = "nickname"
+}
+
+type RunTests(outputHelper: ITestOutputHelper) =
+    let logger = Logging.xunitLogger outputHelper
+
+    [<Fact>]
+    member __.``EmulsionXmpp connects the server``(): unit =
+        let mutable connectionFailedHandler = ignore
+        let disconnect() = connectionFailedHandler(ConnFailedArgs())
+        let mutable connectCalled = false
+        let client =
+            XmppClientFactory.create(
+                addConnectionFailedHandler = (fun _ h -> connectionFailedHandler <- h),
+                connect = (fun () -> async {
+                    connectCalled <- true
+                    disconnect()
+                })
+            )
+        Assert.ThrowsAny<Exception>(fun() -> Async.RunSynchronously <| EmulsionXmpp.run settings logger client ignore)
+        |> ignore
+        Assert.True connectCalled
+
+    [<Fact>]
+    member __.``EmulsionXmpp connects the room``(): unit =
+        let mutable connectionFailedHandler = ignore
+        let disconnect() = connectionFailedHandler(ConnFailedArgs())
+        let mutable joinRoomArgs = Unchecked.defaultof<_>
+        let client =
+            XmppClientFactory.create(
+                addConnectionFailedHandler = (fun _ h -> connectionFailedHandler <- h),
+                joinMultiUserChat = (fun roomJid nickname ->
+                    joinRoomArgs <- (roomJid.FullJid, nickname)
+                    disconnect()
+                )
+            )
+        Assert.ThrowsAny<Exception>(fun() -> Async.RunSynchronously <| EmulsionXmpp.run settings logger client ignore)
+        |> ignore
+        Assert.Equal((settings.Room, settings.Nickname), joinRoomArgs)
+
+type ReceiveMessageTests(outputHelper: ITestOutputHelper) =
+    let logger = Logging.xunitLogger outputHelper
+
+    let runReceiveMessageTest message =
+        let mutable connectionFailedHandler = ignore
+        let receiveHandlers = ResizeArray()
+
+        let sendMessage msg = receiveHandlers |> Seq.iter (fun h -> h msg)
+        let disconnect() = connectionFailedHandler(ConnFailedArgs())
+
+        let mutable messageReceived = None
+        let onMessageReceived = fun m -> messageReceived <- Some m
+
+        let client =
+            XmppClientFactory.create(
+                addConnectionFailedHandler = (fun _ h -> connectionFailedHandler <- h),
+                addMessageHandler = (fun _ h -> receiveHandlers.Add h),
+                joinMultiUserChat = fun _ _ ->
+                    sendMessage message
+                    disconnect()
+            )
+        Assert.ThrowsAny<Exception>(fun() ->
+            Async.RunSynchronously <| EmulsionXmpp.run settings logger client onMessageReceived
+        ) |> ignore
+
+        messageReceived
+
+    [<Fact>]
+    member __.``Ordinary message gets received by the client``(): unit =
+        let incomingMessage = XmppMessageFactory.create("room@conference.example.org/sender",
+                                                        "test",
+                                                        messageType = "groupchat")
+        let receivedMessage = runReceiveMessageTest incomingMessage
+        Assert.Equal(Some <| XmppMessage { author = "sender"; text = "test" }, receivedMessage)
+
+    [<Fact>]
+    member __.``Own message gets skipped by the client``(): unit =
+        let ownMessage = XmppMessageFactory.create("room@conference.example.org/nickname",
+                                                   "test",
+                                                   messageType = "groupchat")
+        let receivedMessage = runReceiveMessageTest ownMessage
+        Assert.Equal(None, receivedMessage)
+
+    [<Fact>]
+    member __.``Historical message gets skipped by the client``(): unit =
+        let historicalMessage = XmppMessageFactory.create("room@conference.example.org/sender",
+                                                          "test",
+                                                          messageType = "groupchat",
+                                                          delayDate = "2019-01-01")
+        let receivedMessage = runReceiveMessageTest historicalMessage
+        Assert.Equal(None, receivedMessage)
+
+    [<Fact>]
+    member __.``Empty message gets skipped by the client``(): unit =
+        let emptyMessage = XmppMessageFactory.create("room@conference.example.org/sender",
+                                                     "",
+                                                     messageType = "groupchat")
+        let receivedMessage = runReceiveMessageTest emptyMessage
+        Assert.Equal(None, receivedMessage)
+
+type SendTests(outputHelper: ITestOutputHelper) =
+    let logger = Logging.xunitLogger outputHelper
+
+    [<Fact>]
+    member __.``send function calls the Send method on the client``(): unit =
+        use ld = Lifetime.Define()
+        let lt = ld.Lifetime
+        let mutable sentMessage = Unchecked.defaultof<_>
+        let client = XmppClientFactory.create(send = fun m ->
+            sentMessage <- m
+            ld.Terminate()
+        )
+
+        let outgoingMessage = { author = "author"; text = "text" }
+        Assert.Throws<TaskCanceledException>(fun () ->
+            Async.RunSynchronously <| EmulsionXmpp.send logger client lt settings outgoingMessage
+        ) |> ignore
+
+        let text = sentMessage.Element(Body).Value
+        Assert.Equal("<author> text", text)
+
+    [<Fact>]
+    member __.``send function awaits the message delivery``(): Task =
+        upcast (async {
+            use ld = Lifetime.Define()
+            let lt = ld.Lifetime
+            let messageId = lt.CreateTaskCompletionSource()
+            let messageHandlers = ResizeArray()
+            let onMessage msg = messageHandlers |> Seq.iter (fun h -> h msg)
+
+            let client =
+                XmppClientFactory.create(
+                    addMessageHandler = (fun _ h -> messageHandlers.Add h),
+                    send = fun m -> messageId.SetResult(Option.get <| SharpXmppHelper.getMessageId m)
+                )
+            let outgoingMessage = { author = "author"; text = "text" }
+
+            let! receival = Async.StartChild <| EmulsionXmpp.send logger client lt settings outgoingMessage
+            let receivalTask = Async.StartAsTask receival
+            let! messageId = Async.AwaitTask messageId.Task // the send has been completed
+
+            // Wait for 100 ms to check that the receival is not completed yet:
+            Assert.False(receivalTask.Wait(TimeSpan.FromMilliseconds 100.0))
+
+            let deliveryMessage = SharpXmppHelper.message messageId "" ""
+            onMessage deliveryMessage
+            do! receival
+        } |> Async.StartAsTask)

Emulsion.Tests/Xmpp/SharpXmppHelper.fs → Emulsion.Tests/Xmpp/SharpXmppHelperTests.fs

@@ -1,4 +1,4 @@
-module Emulsion.Tests.Xmpp.SharpXmppHelper
+module Emulsion.Tests.Xmpp.SharpXmppHelperTests
 
 open System.Xml.Linq
 
@@ -10,7 +10,7 @@ open Emulsion.Xmpp
 
 [<Fact>]
 let ``Message body has a proper namespace``() =
-    let message = SharpXmppHelper.message "cthulhu@test" "text"
+    let message = SharpXmppHelper.message "" "cthulhu@test" "text"
     let body = Seq.exactlyOne(message.Descendants())
     Assert.Equal(XNamespace.Get "jabber:client", body.Name.Namespace)
 

Emulsion.Tests/Xmpp/XmppClientFactory.fs

@@ -0,0 +1,27 @@
+namespace Emulsion.Tests.Xmpp
+
+open Emulsion.Xmpp.XmppClient
+
+type XmppClientFactory =
+    static member create(?connect,
+                         ?joinMultiUserChat,
+                         ?send,
+                         ?addConnectionFailedHandler,
+                         ?addPresenceHandler,
+                         ?addMessageHandler): IXmppClient =
+        let connect = defaultArg connect <| fun () -> async { return () }
+        let joinMultiUserChat = defaultArg joinMultiUserChat <| fun _ _ -> ()
+        let send = defaultArg send ignore
+        let addConnectionFailedHandler = defaultArg addConnectionFailedHandler <| fun _ _ -> ()
+        let addPresenceHandler = defaultArg addPresenceHandler <| fun _ _ -> ()
+        let addMessageHandler = defaultArg addMessageHandler <| fun _ _ -> ()
+        { new IXmppClient with
+            member __.Connect() = connect()
+            member __.JoinMultiUserChat roomJid nickname = joinMultiUserChat roomJid nickname
+            member __.Send m = send m
+            member __.AddConnectionFailedHandler lt handler = addConnectionFailedHandler lt handler
+            member __.AddSignedInHandler _ _ = ()
+            member __.AddElementHandler _ _ = ()
+            member __.AddPresenceHandler lt handler = addPresenceHandler lt handler
+            member __.AddMessageHandler lt handler = addMessageHandler lt handler
+        }