From c209b6fef40db578cd3d098121601a65852fb9df Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Tue, 30 Jul 2019 23:37:30 +0700 Subject: [PATCH 01/22] Async XMPP client proposal (#18) --- Emulsion/Emulsion.fsproj | 1 + Emulsion/Xmpp/AsyncXmppClient.fs | 32 ++++++++++++++++++++++++++++++++ 2 files changed, 33 insertions(+) create mode 100644 Emulsion/Xmpp/AsyncXmppClient.fs diff --git a/Emulsion/Emulsion.fsproj b/Emulsion/Emulsion.fsproj index 92dfc71b..2d3a8c8a 100644 --- a/Emulsion/Emulsion.fsproj +++ b/Emulsion/Emulsion.fsproj @@ -17,6 +17,7 @@ + diff --git a/Emulsion/Xmpp/AsyncXmppClient.fs b/Emulsion/Xmpp/AsyncXmppClient.fs new file mode 100644 index 00000000..09d6db74 --- /dev/null +++ b/Emulsion/Xmpp/AsyncXmppClient.fs @@ -0,0 +1,32 @@ +module Emulsion.Xmpp.AsyncXmppClient +open System.Security +open System.Threading + +type ServerInfo = { + Host: string + Port: uint16 +} + +type SignInInfo = { + Login: string + Password: SecureString +} + +type RoomInfo = { + RoomJid: string + Nickname: string +} + +type MessageInfo = { + RecipientJid: string + Text: string +} + +type Lifetime = CancellationToken // TODO[F]: Determine a proper lifetime? + +type IAsyncXmppClient = + abstract member Connect : ServerInfo -> Async + abstract member SignIn : SignInInfo -> Async + abstract member EnterRoom : RoomInfo -> Async + abstract member SendMessage : Lifetime -> MessageInfo -> Async + abstract member DisposeAsync : unit -> Async From fc52a2f92a125b6b9ae3bacc06c17a9134d06f5b Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Tue, 30 Jul 2019 23:53:10 +0700 Subject: [PATCH 02/22] Update the async XMPP API proposal (#18) --- Emulsion/Xmpp/AsyncXmppClient.fs | 26 ++++++++++++++++++++++---- 1 file changed, 22 insertions(+), 4 deletions(-) diff --git a/Emulsion/Xmpp/AsyncXmppClient.fs b/Emulsion/Xmpp/AsyncXmppClient.fs index 09d6db74..a09e16a6 100644 --- a/Emulsion/Xmpp/AsyncXmppClient.fs +++ b/Emulsion/Xmpp/AsyncXmppClient.fs @@ -1,4 +1,5 @@ module Emulsion.Xmpp.AsyncXmppClient + open System.Security open System.Threading @@ -12,8 +13,10 @@ type SignInInfo = { Password: SecureString } +type Jid = string + type RoomInfo = { - RoomJid: string + RoomJid: Jid Nickname: string } @@ -22,11 +25,26 @@ type MessageInfo = { Text: string } +type MessageDeliveryInfo = Async // Resolves after the message is guaranteed to be delivered to the recipient. + type Lifetime = CancellationToken // TODO[F]: Determine a proper lifetime? type IAsyncXmppClient = - abstract member Connect : ServerInfo -> Async - abstract member SignIn : SignInInfo -> Async + /// Establish a connection to the server. Returns a connection lifetime that will terminate if the connection + /// terminates. + abstract member Connect : ServerInfo -> Async + + /// Sign in with the provided credentials. Returns a session lifetime that will terminate if the session terminates. + abstract member SignIn : SignInInfo -> Async + + /// Enter the room, returning the in-room lifetime. Will terminate if kicked or left the room. abstract member EnterRoom : RoomInfo -> Async - abstract member SendMessage : Lifetime -> MessageInfo -> Async + + /// Sends the message to the room. + abstract member SendMessage : MessageInfo -> Async + + /// Waits for the message to be delivered. + abstract member AwaitMessageDelivery : MessageDeliveryInfo -> Async + + /// Disconnects from the server (if connected) and frees all the resources associated with the client. abstract member DisposeAsync : unit -> Async From 4118da00a1d242c5a54ead4b9db3c61cbb40a4dc Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sun, 1 Sep 2019 22:06:38 +0700 Subject: [PATCH 03/22] Implement lifetimes and SharpXmppClient.signIn (#18) --- Emulsion.Tests/Xmpp/XmppMessageFactory.fs | 1 + Emulsion/Emulsion.fsproj | 4 + Emulsion/ExceptionUtils.fs | 8 ++ Emulsion/Lifetimes.fs | 33 ++++++++ Emulsion/Xmpp/AsyncXmppClient.fs | 16 ++-- Emulsion/Xmpp/SharpXmppClient.fs | 94 +++++++++++++++++++++++ Emulsion/Xmpp/SharpXmppHelper.fs | 36 ++++++++- Emulsion/Xmpp/XmppElements.fs | 10 +++ 8 files changed, 187 insertions(+), 15 deletions(-) create mode 100644 Emulsion/ExceptionUtils.fs create mode 100644 Emulsion/Lifetimes.fs create mode 100644 Emulsion/Xmpp/SharpXmppClient.fs create mode 100644 Emulsion/Xmpp/XmppElements.fs diff --git a/Emulsion.Tests/Xmpp/XmppMessageFactory.fs b/Emulsion.Tests/Xmpp/XmppMessageFactory.fs index f0dbc00c..fa86e0c9 100644 --- a/Emulsion.Tests/Xmpp/XmppMessageFactory.fs +++ b/Emulsion.Tests/Xmpp/XmppMessageFactory.fs @@ -3,6 +3,7 @@ namespace Emulsion.Tests.Xmpp open System.Xml.Linq open SharpXMPP.XMPP.Client.Elements +open Emulsion.Xmpp.SharpXmppHelper.Attributes open Emulsion.Xmpp.SharpXmppHelper.Elements type XmppMessageFactory = diff --git a/Emulsion/Emulsion.fsproj b/Emulsion/Emulsion.fsproj index 2d3a8c8a..a59c3ec3 100644 --- a/Emulsion/Emulsion.fsproj +++ b/Emulsion/Emulsion.fsproj @@ -11,13 +11,17 @@ + + + + diff --git a/Emulsion/ExceptionUtils.fs b/Emulsion/ExceptionUtils.fs new file mode 100644 index 00000000..28f54d27 --- /dev/null +++ b/Emulsion/ExceptionUtils.fs @@ -0,0 +1,8 @@ +module Emulsion.ExceptionUtils + +open System.Runtime.ExceptionServices + +let reraise (ex: exn): 'a = + let edi = ExceptionDispatchInfo.Capture ex + edi.Throw() + failwith "Impossible" diff --git a/Emulsion/Lifetimes.fs b/Emulsion/Lifetimes.fs new file mode 100644 index 00000000..b17e7098 --- /dev/null +++ b/Emulsion/Lifetimes.fs @@ -0,0 +1,33 @@ +module Emulsion.Lifetimes + +open System +open System.Threading +open System.Threading.Tasks + +type LifetimeDefinition(cts: CancellationTokenSource) = + new() = new LifetimeDefinition(new CancellationTokenSource()) + member __.Lifetime: Lifetime = Lifetime(cts.Token) + member __.Terminate(): unit = cts.Cancel() + interface IDisposable with + member __.Dispose() = cts.Dispose() +and Lifetime(token: CancellationToken) = + member __.Token: CancellationToken = token + member __.CreateNested(): LifetimeDefinition = + let cts = CancellationTokenSource.CreateLinkedTokenSource token + new LifetimeDefinition(cts) + member __.OnTermination(action: Action): unit = + token.Register action |> ignore + + /// Schedules a termination action, and returns an IDisposable. Whenever this instance is disposed, the action will + /// be removed from scheduled on cancellation. + member __.OnTerminationRemovable(action: Action): IDisposable = + upcast token.Register action + +let nestedTaskCompletionSource<'T>(lifetime: Lifetime): TaskCompletionSource<'T> = + let tcs = new TaskCompletionSource<'T>() + + // As an optimization, we'll remove the action after the task has been completed to clean up the memory: + let action = lifetime.OnTerminationRemovable(fun () -> tcs.TrySetCanceled() |> ignore) + tcs.Task.ContinueWith(fun (t: Task<'T>) -> action.Dispose()) |> ignore + + tcs diff --git a/Emulsion/Xmpp/AsyncXmppClient.fs b/Emulsion/Xmpp/AsyncXmppClient.fs index a09e16a6..66bd03ff 100644 --- a/Emulsion/Xmpp/AsyncXmppClient.fs +++ b/Emulsion/Xmpp/AsyncXmppClient.fs @@ -1,7 +1,8 @@ module Emulsion.Xmpp.AsyncXmppClient open System.Security -open System.Threading + +open Emulsion.Lifetimes type ServerInfo = { Host: string @@ -10,7 +11,7 @@ type ServerInfo = { type SignInInfo = { Login: string - Password: SecureString + Password: string } type Jid = string @@ -21,21 +22,14 @@ type RoomInfo = { } type MessageInfo = { - RecipientJid: string + RecipientJid: Jid Text: string } type MessageDeliveryInfo = Async // Resolves after the message is guaranteed to be delivered to the recipient. -type Lifetime = CancellationToken // TODO[F]: Determine a proper lifetime? - type IAsyncXmppClient = - /// Establish a connection to the server. Returns a connection lifetime that will terminate if the connection - /// terminates. - abstract member Connect : ServerInfo -> Async - - /// Sign in with the provided credentials. Returns a session lifetime that will terminate if the session terminates. - abstract member SignIn : SignInInfo -> Async + // TODO[F]: Implement the remaining functions in SharpXmppClient /// Enter the room, returning the in-room lifetime. Will terminate if kicked or left the room. abstract member EnterRoom : RoomInfo -> Async diff --git a/Emulsion/Xmpp/SharpXmppClient.fs b/Emulsion/Xmpp/SharpXmppClient.fs new file mode 100644 index 00000000..b1af5196 --- /dev/null +++ b/Emulsion/Xmpp/SharpXmppClient.fs @@ -0,0 +1,94 @@ +module Emulsion.Xmpp.SharpXmppClient + +open System + +open Serilog +open SharpXMPP +open SharpXMPP.XMPP + +open Emulsion +open Emulsion.Lifetimes +open Emulsion.Xmpp.AsyncXmppClient +open SharpXMPP.XMPP.Client.Elements + +/// Establish a connection to the server and log in. Returns a connection lifetime that will terminate if the connection +/// terminates. +let signIn (logger: ILogger) (signInInfo: SignInInfo): Async = async { + let client = new XmppClient(JID(signInInfo.Login), signInInfo.Password) + let connectionLifetime = new LifetimeDefinition() + client.add_ConnectionFailed <| XmppConnection.ConnectionFailedHandler( + fun _ error -> + logger.Error(error.Exception, "Connection failed: {Message}", error.Message) + connectionLifetime.Terminate() + ) + let! cancellationToken = Async.CancellationToken + use _ = cancellationToken.Register(fun () -> + logger.Information("Closing the connection due to external cancellation") + client.Close() + ) + do! Async.AwaitTask(client.ConnectAsync cancellationToken) // TODO[F]: Check if it will call the ConnectionFailed handler on cancellation + return client, connectionLifetime.Lifetime +} + +let private addPresenceHandler (lifetime: Lifetime) (client: XmppClient) handler = + let handlerDelegate = XmppConnection.PresenceHandler(fun _ p -> handler p) + client.add_Presence handlerDelegate + lifetime.OnTermination (fun () -> client.remove_Presence handlerDelegate) + +let private isSelfPresence (roomInfo: RoomInfo) (presence: XMPPPresence) = + let presence = SharpXmppHelper.parsePresence presence + let expectedJid = sprintf "%s/%s" roomInfo.RoomJid roomInfo.Nickname + presence.From = expectedJid && Array.contains 110 presence.States + +let private isLeavePresence (roomInfo: RoomInfo) (presence: XMPPPresence) = + let presence = SharpXmppHelper.parsePresence presence + let expectedJid = sprintf "%s/%s" roomInfo.RoomJid roomInfo.Nickname + presence.From = expectedJid && Array.contains 110 presence.States && presence.Type = "unavailable" + +let private extractException (roomInfo: RoomInfo) (presence: XMPPPresence) = + let presence = SharpXmppHelper.parsePresence presence + let expectedJid = sprintf "%s/%s" roomInfo.RoomJid roomInfo.Nickname + if presence.From = expectedJid then + presence.Error + |> Option.map (fun e -> Exception(sprintf "Error: %A" e)) + else None + +let enterRoom (client: XmppClient) (lifetime: Lifetime) (roomInfo: RoomInfo): Async = async { + use connectionLifetimeDefinition = lifetime.CreateNested() + let connectionLifetime = connectionLifetimeDefinition.Lifetime + + let roomLifetimeDefinition = lifetime.CreateNested() + let roomLifetime = roomLifetimeDefinition.Lifetime + + let tcs = nestedTaskCompletionSource connectionLifetime + + // Enter room successfully handler: + addPresenceHandler connectionLifetime client (fun presence -> + if isSelfPresence roomInfo presence + then tcs.SetResult() + ) + + // Error handler: + addPresenceHandler connectionLifetime client (fun presence -> + match extractException roomInfo presence with + | Some ex -> tcs.SetException ex + | None -> () + ) + + // Room leave handler: + addPresenceHandler roomLifetime client (fun presence -> + if isLeavePresence roomInfo presence + then roomLifetimeDefinition.Terminate() + ) + + try + // Start the enter process, wait for a result: + SharpXmppHelper.joinRoom client roomInfo.RoomJid roomInfo.Nickname + do! Async.AwaitTask tcs.Task + return roomLifetime + with + | ex -> + // In case of an error, terminate the room lifetime: + roomLifetimeDefinition.Terminate() + return ExceptionUtils.reraise ex +} diff --git a/Emulsion/Xmpp/SharpXmppHelper.fs b/Emulsion/Xmpp/SharpXmppHelper.fs index 6740df6a..bb1d52fa 100644 --- a/Emulsion/Xmpp/SharpXmppHelper.fs +++ b/Emulsion/Xmpp/SharpXmppHelper.fs @@ -9,17 +9,29 @@ open SharpXMPP.XMPP.Client.MUC.Bookmarks.Elements open SharpXMPP.XMPP.Client.Elements open Emulsion +open Emulsion.Xmpp.XmppElements -module Elements = - let Body = XName.Get("body", Namespaces.JabberClient) - let Delay = XName.Get("delay", "urn:xmpp:delay") +module Namespaces = + let MucUser = "http://jabber.org/protocol/muc#user" + +module Attributes = + let Code = XName.Get "code" let From = XName.Get "from" let Jid = XName.Get "jid" - let Nick = XName.Get("nick", Namespaces.StorageBookmarks) let Stamp = XName.Get "stamp" let To = XName.Get "to" let Type = XName.Get "type" +open Attributes + +module Elements = + let Body = XName.Get("body", Namespaces.JabberClient) + let Delay = XName.Get("delay", "urn:xmpp:delay") + let Error = XName.Get "error" + let Nick = XName.Get("nick", Namespaces.StorageBookmarks) + let Status = XName.Get "status" + let X = XName.Get("x", Namespaces.MucUser) + open Elements let private bookmark (roomJid: string) (nickname: string): BookmarkedConference = @@ -75,3 +87,19 @@ let parseMessage (message: XMPPMessage): Message = |> Option.map getResource |> Option.defaultValue "[UNKNOWN USER]" { author = nickname; text = message.Text } + +let parsePresence(presence: XMPPPresence): Presence = + let from = getAttributeValue presence From |> Option.defaultValue "" + let presenceType = getAttributeValue presence Type |> Option.defaultValue "" + let states = + presence.Element X + |> Option.ofObj + |> Option.map (fun x -> + x.Elements(Status) + |> Seq.choose (fun s -> getAttributeValue s Code) + |> Seq.map int + ) + |> Option.map Seq.toArray + |> Option.defaultWith(fun () -> Array.empty) + let error = presence.Element Error |> Option.ofObj + { From = from; Type = presenceType; States = states; Error = error } diff --git a/Emulsion/Xmpp/XmppElements.fs b/Emulsion/Xmpp/XmppElements.fs new file mode 100644 index 00000000..b3d83cb0 --- /dev/null +++ b/Emulsion/Xmpp/XmppElements.fs @@ -0,0 +1,10 @@ +namespace Emulsion.Xmpp.XmppElements + +open System.Xml.Linq + +type Presence = { + From: string + States: int[] + Error: XElement option + Type: string +} From 83afe103a5792815536b6852872f27c2c38d787c Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Mon, 2 Sep 2019 23:34:49 +0700 Subject: [PATCH 04/22] Implement a sendRoomMessage function (#18) --- Emulsion.Tests/Xmpp/SharpXmppHelper.fs | 2 +- Emulsion/Xmpp/AsyncXmppClient.fs | 6 ----- Emulsion/Xmpp/SharpXmppClient.fs | 32 ++++++++++++++++++++++++++ Emulsion/Xmpp/SharpXmppHelper.fs | 8 ++++++- Emulsion/Xmpp/XmppClient.fs | 2 +- 5 files changed, 41 insertions(+), 9 deletions(-) diff --git a/Emulsion.Tests/Xmpp/SharpXmppHelper.fs b/Emulsion.Tests/Xmpp/SharpXmppHelper.fs index 2cd38324..a7cb773a 100644 --- a/Emulsion.Tests/Xmpp/SharpXmppHelper.fs +++ b/Emulsion.Tests/Xmpp/SharpXmppHelper.fs @@ -10,7 +10,7 @@ open Emulsion.Xmpp [] let ``Message body has a proper namespace``() = - let message = SharpXmppHelper.message "cthulhu@test" "text" + let message = SharpXmppHelper.message None "cthulhu@test" "text" let body = Seq.exactlyOne(message.Descendants()) Assert.Equal(XNamespace.Get "jabber:client", body.Name.Namespace) diff --git a/Emulsion/Xmpp/AsyncXmppClient.fs b/Emulsion/Xmpp/AsyncXmppClient.fs index 66bd03ff..9fdea825 100644 --- a/Emulsion/Xmpp/AsyncXmppClient.fs +++ b/Emulsion/Xmpp/AsyncXmppClient.fs @@ -31,12 +31,6 @@ type MessageDeliveryInfo = Async // Resolves after the message is guarante type IAsyncXmppClient = // TODO[F]: Implement the remaining functions in SharpXmppClient - /// Enter the room, returning the in-room lifetime. Will terminate if kicked or left the room. - abstract member EnterRoom : RoomInfo -> Async - - /// Sends the message to the room. - abstract member SendMessage : MessageInfo -> Async - /// Waits for the message to be delivered. abstract member AwaitMessageDelivery : MessageDeliveryInfo -> Async diff --git a/Emulsion/Xmpp/SharpXmppClient.fs b/Emulsion/Xmpp/SharpXmppClient.fs index b1af5196..031db26f 100644 --- a/Emulsion/Xmpp/SharpXmppClient.fs +++ b/Emulsion/Xmpp/SharpXmppClient.fs @@ -8,6 +8,7 @@ open SharpXMPP.XMPP open Emulsion open Emulsion.Lifetimes +open Emulsion.Xmpp open Emulsion.Xmpp.AsyncXmppClient open SharpXMPP.XMPP.Client.Elements @@ -53,6 +54,12 @@ let private extractException (roomInfo: RoomInfo) (presence: XMPPPresence) = |> Option.map (fun e -> Exception(sprintf "Error: %A" e)) else None +let private addMessageHandler (lifetime: Lifetime) (client: XmppClient) handler = + let handlerDelegate = XmppConnection.MessageHandler handler + client.add_Message handlerDelegate + lifetime.OnTermination(fun () -> client.remove_Message handlerDelegate) + +/// Enter the room, returning the in-room lifetime. Will terminate if kicked or left the room. let enterRoom (client: XmppClient) (lifetime: Lifetime) (roomInfo: RoomInfo): Async = async { use connectionLifetimeDefinition = lifetime.CreateNested() let connectionLifetime = connectionLifetimeDefinition.Lifetime @@ -92,3 +99,28 @@ let enterRoom (client: XmppClient) (lifetime: Lifetime) (roomInfo: RoomInfo): As roomLifetimeDefinition.Terminate() return ExceptionUtils.reraise ex } + +let private hasMessageId messageId message = + SharpXmppHelper.getMessageId message = Some messageId + +let private awaitMessageReceival (lifetime: Lifetime) client messageId = async { + use messageLifetimeDefinition = lifetime.CreateNested() + let messageLifetime = messageLifetimeDefinition.Lifetime + let messageReceivedTask = nestedTaskCompletionSource messageLifetime + addMessageHandler lifetime client (fun _ message -> + if hasMessageId messageId message then + messageReceivedTask.SetResult() + ) + + do! Async.AwaitTask messageReceivedTask.Task +} + +/// Sends the message to the room. Returns an object that allows to track the message receival. +let sendRoomMessage (lifetime: Lifetime) (client: XmppClient) (messageInfo: MessageInfo): Async = + async { + let messageId = Guid.NewGuid().ToString() // TODO[F]: Move to a new function + let message = SharpXmppHelper.message (Some messageId) messageInfo.RecipientJid messageInfo.Text + let! result = Async.StartChild <| awaitMessageReceival lifetime client messageId + client.Send message + return result + } diff --git a/Emulsion/Xmpp/SharpXmppHelper.fs b/Emulsion/Xmpp/SharpXmppHelper.fs index bb1d52fa..286c77ba 100644 --- a/Emulsion/Xmpp/SharpXmppHelper.fs +++ b/Emulsion/Xmpp/SharpXmppHelper.fs @@ -17,6 +17,7 @@ module Namespaces = module Attributes = let Code = XName.Get "code" let From = XName.Get "from" + let Id = XName.Get "id" let Jid = XName.Get "jid" let Stamp = XName.Get "stamp" let To = XName.Get "to" @@ -45,8 +46,10 @@ let joinRoom (client: XmppClient) (roomJid: string) (nickname: string): unit = let room = bookmark roomJid nickname client.BookmarkManager.Join(room) -let message (toAddr : string) (text : string) = +let message (id: string option) (toAddr: string) (text: string): XMPPMessage = + // TODO[F]: Make id a mandatory parameter? let m = XMPPMessage() + id |> Option.iter (fun id -> m.SetAttributeValue(Id, id)) m.SetAttributeValue(Type, "groupchat") m.SetAttributeValue(To, toAddr) let body = XElement(Body) @@ -81,6 +84,9 @@ let isGroupChatMessage(message: XMPPMessage): bool = let isEmptyMessage(message: XMPPMessage): bool = String.IsNullOrWhiteSpace message.Text +let getMessageId(message: XMPPMessage): string option = + getAttributeValue message Id + let parseMessage (message: XMPPMessage): Message = let nickname = getAttributeValue message From diff --git a/Emulsion/Xmpp/XmppClient.fs b/Emulsion/Xmpp/XmppClient.fs index 7c20b2b3..ec29bd4b 100644 --- a/Emulsion/Xmpp/XmppClient.fs +++ b/Emulsion/Xmpp/XmppClient.fs @@ -79,5 +79,5 @@ let run (logger: ILogger) (client: XmppClient): Async = let send (settings: XmppSettings) (client: XmppClient) (message: Message): unit = let text = sprintf "<%s> %s" message.author message.text - SharpXmppHelper.message settings.Room text + SharpXmppHelper.message None settings.Room text |> client.Send From 735a16c6c2d2e57751bccceb0d1ca0298f116ec8 Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Mon, 2 Sep 2019 23:42:54 +0700 Subject: [PATCH 05/22] Fix a comment (#18) --- Emulsion/Lifetimes.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Emulsion/Lifetimes.fs b/Emulsion/Lifetimes.fs index b17e7098..4024adcd 100644 --- a/Emulsion/Lifetimes.fs +++ b/Emulsion/Lifetimes.fs @@ -19,7 +19,7 @@ and Lifetime(token: CancellationToken) = token.Register action |> ignore /// Schedules a termination action, and returns an IDisposable. Whenever this instance is disposed, the action will - /// be removed from scheduled on cancellation. + /// be removed from the list of actions scheduled on the lifetime termination. member __.OnTerminationRemovable(action: Action): IDisposable = upcast token.Register action From a3c874a21c272e9145ea21b306c931dbe7776d28 Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Thu, 5 Sep 2019 23:44:02 +0700 Subject: [PATCH 06/22] Convert all the interface code to the module, update TODOs (#18) --- Emulsion/Emulsion.fsproj | 3 +-- Emulsion/Lifetimes.fs | 1 + Emulsion/Xmpp/AsyncXmppClient.fs | 38 --------------------------- Emulsion/Xmpp/SharpXmppClient.fs | 44 +++++++++++++++++++++++++++++--- Emulsion/Xmpp/XmppClient.fs | 1 + 5 files changed, 43 insertions(+), 44 deletions(-) delete mode 100644 Emulsion/Xmpp/AsyncXmppClient.fs diff --git a/Emulsion/Emulsion.fsproj b/Emulsion/Emulsion.fsproj index a59c3ec3..53fb3e87 100644 --- a/Emulsion/Emulsion.fsproj +++ b/Emulsion/Emulsion.fsproj @@ -19,9 +19,8 @@ - - + diff --git a/Emulsion/Lifetimes.fs b/Emulsion/Lifetimes.fs index 4024adcd..c5aa457a 100644 --- a/Emulsion/Lifetimes.fs +++ b/Emulsion/Lifetimes.fs @@ -4,6 +4,7 @@ open System open System.Threading open System.Threading.Tasks +// TODO[F]: Replace with JetBrains.Lifetimes package type LifetimeDefinition(cts: CancellationTokenSource) = new() = new LifetimeDefinition(new CancellationTokenSource()) member __.Lifetime: Lifetime = Lifetime(cts.Token) diff --git a/Emulsion/Xmpp/AsyncXmppClient.fs b/Emulsion/Xmpp/AsyncXmppClient.fs deleted file mode 100644 index 9fdea825..00000000 --- a/Emulsion/Xmpp/AsyncXmppClient.fs +++ /dev/null @@ -1,38 +0,0 @@ -module Emulsion.Xmpp.AsyncXmppClient - -open System.Security - -open Emulsion.Lifetimes - -type ServerInfo = { - Host: string - Port: uint16 -} - -type SignInInfo = { - Login: string - Password: string -} - -type Jid = string - -type RoomInfo = { - RoomJid: Jid - Nickname: string -} - -type MessageInfo = { - RecipientJid: Jid - Text: string -} - -type MessageDeliveryInfo = Async // Resolves after the message is guaranteed to be delivered to the recipient. - -type IAsyncXmppClient = - // TODO[F]: Implement the remaining functions in SharpXmppClient - - /// Waits for the message to be delivered. - abstract member AwaitMessageDelivery : MessageDeliveryInfo -> Async - - /// Disconnects from the server (if connected) and frees all the resources associated with the client. - abstract member DisposeAsync : unit -> Async diff --git a/Emulsion/Xmpp/SharpXmppClient.fs b/Emulsion/Xmpp/SharpXmppClient.fs index 031db26f..fd7fec7d 100644 --- a/Emulsion/Xmpp/SharpXmppClient.fs +++ b/Emulsion/Xmpp/SharpXmppClient.fs @@ -1,3 +1,4 @@ +// TODO[F]: Add tests for this module module Emulsion.Xmpp.SharpXmppClient open System @@ -9,13 +10,41 @@ open SharpXMPP.XMPP open Emulsion open Emulsion.Lifetimes open Emulsion.Xmpp -open Emulsion.Xmpp.AsyncXmppClient open SharpXMPP.XMPP.Client.Elements +type ServerInfo = { + Host: string + Port: uint16 +} + +type SignInInfo = { + Login: string + Password: string +} + +type Jid = string + +type RoomInfo = { + RoomJid: Jid + Nickname: string +} + +type MessageInfo = { + RecipientJid: Jid + Text: string +} + +type MessageDeliveryInfo = { + MessageId: string + + /// Resolves after the message is guaranteed to be delivered to the recipient. + Delivery: Async +} + /// Establish a connection to the server and log in. Returns a connection lifetime that will terminate if the connection /// terminates. let signIn (logger: ILogger) (signInInfo: SignInInfo): Async = async { - let client = new XmppClient(JID(signInInfo.Login), signInInfo.Password) + let client = new XmppClient(JID(signInInfo.Login), signInInfo.Password) // TODO[F]: Add the logs back let connectionLifetime = new LifetimeDefinition() client.add_ConnectionFailed <| XmppConnection.ConnectionFailedHandler( fun _ error -> @@ -120,7 +149,14 @@ let sendRoomMessage (lifetime: Lifetime) (client: XmppClient) (messageInfo: Mess async { let messageId = Guid.NewGuid().ToString() // TODO[F]: Move to a new function let message = SharpXmppHelper.message (Some messageId) messageInfo.RecipientJid messageInfo.Text - let! result = Async.StartChild <| awaitMessageReceival lifetime client messageId + let! delivery = Async.StartChild <| awaitMessageReceival lifetime client messageId client.Send message - return result + return { + MessageId = messageId + Delivery = delivery + } } + +/// Waits for the message to be delivered. +let awaitMessageDelivery (deliveryInfo: MessageDeliveryInfo): Async = + deliveryInfo.Delivery diff --git a/Emulsion/Xmpp/XmppClient.fs b/Emulsion/Xmpp/XmppClient.fs index ec29bd4b..4e126712 100644 --- a/Emulsion/Xmpp/XmppClient.fs +++ b/Emulsion/Xmpp/XmppClient.fs @@ -10,6 +10,7 @@ open SharpXMPP.XMPP open Emulsion open Emulsion.Settings +// TODO[F]: This client should be removed let private connectionFailedHandler (logger: ILogger) = XmppConnection.ConnectionFailedHandler(fun s e -> logger.Error(e.Exception, "XMPP connection failed: {Message}", e.Message) ()) From 34814a468893f085450ffcd0f869db16c8c6b62c Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Thu, 5 Sep 2019 23:58:51 +0700 Subject: [PATCH 07/22] Migrate to JetBrains.Lifetimes (#18) --- Emulsion/Emulsion.fsproj | 1 + Emulsion/Lifetimes.fs | 29 ++++++----------------------- Emulsion/Xmpp/SharpXmppClient.fs | 5 +++-- 3 files changed, 10 insertions(+), 25 deletions(-) diff --git a/Emulsion/Emulsion.fsproj b/Emulsion/Emulsion.fsproj index 53fb3e87..1969a66c 100644 --- a/Emulsion/Emulsion.fsproj +++ b/Emulsion/Emulsion.fsproj @@ -31,6 +31,7 @@ + diff --git a/Emulsion/Lifetimes.fs b/Emulsion/Lifetimes.fs index c5aa457a..34a01f11 100644 --- a/Emulsion/Lifetimes.fs +++ b/Emulsion/Lifetimes.fs @@ -1,34 +1,17 @@ module Emulsion.Lifetimes -open System -open System.Threading open System.Threading.Tasks -// TODO[F]: Replace with JetBrains.Lifetimes package -type LifetimeDefinition(cts: CancellationTokenSource) = - new() = new LifetimeDefinition(new CancellationTokenSource()) - member __.Lifetime: Lifetime = Lifetime(cts.Token) - member __.Terminate(): unit = cts.Cancel() - interface IDisposable with - member __.Dispose() = cts.Dispose() -and Lifetime(token: CancellationToken) = - member __.Token: CancellationToken = token - member __.CreateNested(): LifetimeDefinition = - let cts = CancellationTokenSource.CreateLinkedTokenSource token - new LifetimeDefinition(cts) - member __.OnTermination(action: Action): unit = - token.Register action |> ignore - - /// Schedules a termination action, and returns an IDisposable. Whenever this instance is disposed, the action will - /// be removed from the list of actions scheduled on the lifetime termination. - member __.OnTerminationRemovable(action: Action): IDisposable = - upcast token.Register action +open JetBrains.Lifetimes +/// Creates a task completion source that will be canceled if lifetime terminates before it is completed successfully. let nestedTaskCompletionSource<'T>(lifetime: Lifetime): TaskCompletionSource<'T> = let tcs = new TaskCompletionSource<'T>() - // As an optimization, we'll remove the action after the task has been completed to clean up the memory: - let action = lifetime.OnTerminationRemovable(fun () -> tcs.TrySetCanceled() |> ignore) + // Register a cancellation action, and remove the action when the task is completed (to not store the unnecessary + // action after we already know it won't cancel the task). + let cancellationToken = lifetime.ToCancellationToken() + let action = cancellationToken.Register(fun () -> tcs.TrySetCanceled() |> ignore) tcs.Task.ContinueWith(fun (t: Task<'T>) -> action.Dispose()) |> ignore tcs diff --git a/Emulsion/Xmpp/SharpXmppClient.fs b/Emulsion/Xmpp/SharpXmppClient.fs index fd7fec7d..2eddda35 100644 --- a/Emulsion/Xmpp/SharpXmppClient.fs +++ b/Emulsion/Xmpp/SharpXmppClient.fs @@ -3,6 +3,7 @@ module Emulsion.Xmpp.SharpXmppClient open System +open JetBrains.Lifetimes open Serilog open SharpXMPP open SharpXMPP.XMPP @@ -63,7 +64,7 @@ let signIn (logger: ILogger) (signInInfo: SignInInfo): Async handler p) client.add_Presence handlerDelegate - lifetime.OnTermination (fun () -> client.remove_Presence handlerDelegate) + lifetime.OnTermination (fun () -> client.remove_Presence handlerDelegate) |> ignore let private isSelfPresence (roomInfo: RoomInfo) (presence: XMPPPresence) = let presence = SharpXmppHelper.parsePresence presence @@ -86,7 +87,7 @@ let private extractException (roomInfo: RoomInfo) (presence: XMPPPresence) = let private addMessageHandler (lifetime: Lifetime) (client: XmppClient) handler = let handlerDelegate = XmppConnection.MessageHandler handler client.add_Message handlerDelegate - lifetime.OnTermination(fun () -> client.remove_Message handlerDelegate) + lifetime.OnTermination(fun () -> client.remove_Message handlerDelegate) |> ignore /// Enter the room, returning the in-room lifetime. Will terminate if kicked or left the room. let enterRoom (client: XmppClient) (lifetime: Lifetime) (roomInfo: RoomInfo): Async = async { From 4817e3835eeecca3c0e1ec1bfba13126d7472b51 Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Fri, 6 Sep 2019 23:51:07 +0700 Subject: [PATCH 08/22] Add tests for the simplified connect function, add IXmppClient (#18) Also add and clarify some TODO comments. --- Emulsion.Tests/Emulsion.Tests.fsproj | 2 ++ Emulsion.Tests/Xmpp/SharpXmppClientTests.fs | 28 +++++++++++++++ Emulsion.Tests/Xmpp/XmppClientFactory.fs | 12 +++++++ Emulsion/Xmpp/Client.fs | 1 + Emulsion/Xmpp/SharpXmppClient.fs | 39 +++++++-------------- Emulsion/Xmpp/XmppClient.fs | 7 ++++ 6 files changed, 62 insertions(+), 27 deletions(-) create mode 100644 Emulsion.Tests/Xmpp/SharpXmppClientTests.fs create mode 100644 Emulsion.Tests/Xmpp/XmppClientFactory.fs diff --git a/Emulsion.Tests/Emulsion.Tests.fsproj b/Emulsion.Tests/Emulsion.Tests.fsproj index d92458df..407a72e2 100644 --- a/Emulsion.Tests/Emulsion.Tests.fsproj +++ b/Emulsion.Tests/Emulsion.Tests.fsproj @@ -16,8 +16,10 @@ + + diff --git a/Emulsion.Tests/Xmpp/SharpXmppClientTests.fs b/Emulsion.Tests/Xmpp/SharpXmppClientTests.fs new file mode 100644 index 00000000..3872094e --- /dev/null +++ b/Emulsion.Tests/Xmpp/SharpXmppClientTests.fs @@ -0,0 +1,28 @@ +namespace Emulsion.Tests.Xmpp + +open SharpXMPP +open Xunit +open Xunit.Abstractions + +open Emulsion.Tests.TestUtils +open Emulsion.Xmpp + +type SharpXmppClientTests(testOutput: ITestOutputHelper) = + let logger = Logging.xunitLogger testOutput + + [] + member __.``connect function calls the Connect method of the client passed``(): unit = + let mutable connectCalled = false + let client = XmppClientFactory.create(fun () -> async { connectCalled <- true }) + Async.RunSynchronously <| SharpXmppClient.connect logger client |> ignore + Assert.True connectCalled + + [] + member __.``connect function returns a lifetime terminated whenever the ConnectionFailed callback is triggered``() + : unit = + let mutable callback = ignore + let client = XmppClientFactory.create(addConnectionFailedHandler = fun _ h -> callback <- h) + let lt = Async.RunSynchronously <| SharpXmppClient.connect logger client + Assert.True lt.IsAlive + callback(ConnFailedArgs()) + Assert.False lt.IsAlive diff --git a/Emulsion.Tests/Xmpp/XmppClientFactory.fs b/Emulsion.Tests/Xmpp/XmppClientFactory.fs new file mode 100644 index 00000000..4805a12f --- /dev/null +++ b/Emulsion.Tests/Xmpp/XmppClientFactory.fs @@ -0,0 +1,12 @@ +namespace Emulsion.Tests.Xmpp + +open Emulsion.Xmpp.XmppClient + +type XmppClientFactory = + static member create(?connect, ?addConnectionFailedHandler): IXmppClient = + let connect = defaultArg connect <| fun () -> async { return () } + let addConnectionFailedHandler = defaultArg addConnectionFailedHandler <| fun _ _ -> () + { new IXmppClient with + member __.Connect() = connect() + member __.AddConnectionFailedHandler lt handler = addConnectionFailedHandler lt handler + } diff --git a/Emulsion/Xmpp/Client.fs b/Emulsion/Xmpp/Client.fs index a60888ec..4263a55e 100644 --- a/Emulsion/Xmpp/Client.fs +++ b/Emulsion/Xmpp/Client.fs @@ -6,6 +6,7 @@ open Emulsion open Emulsion.MessageSystem open Emulsion.Settings +// TODO[F]: Rename to an XmppMessageSystem? type Client(ctx: ServiceContext, cancellationToken: CancellationToken, settings: XmppSettings) = inherit MessageSystemBase(ctx, cancellationToken) diff --git a/Emulsion/Xmpp/SharpXmppClient.fs b/Emulsion/Xmpp/SharpXmppClient.fs index 2eddda35..7ec82629 100644 --- a/Emulsion/Xmpp/SharpXmppClient.fs +++ b/Emulsion/Xmpp/SharpXmppClient.fs @@ -1,4 +1,3 @@ -// TODO[F]: Add tests for this module module Emulsion.Xmpp.SharpXmppClient open System @@ -6,22 +5,12 @@ open System open JetBrains.Lifetimes open Serilog open SharpXMPP -open SharpXMPP.XMPP +open SharpXMPP.XMPP.Client.Elements open Emulsion open Emulsion.Lifetimes open Emulsion.Xmpp -open SharpXMPP.XMPP.Client.Elements - -type ServerInfo = { - Host: string - Port: uint16 -} - -type SignInInfo = { - Login: string - Password: string -} +open Emulsion.Xmpp.XmppClient type Jid = string @@ -44,21 +33,14 @@ type MessageDeliveryInfo = { /// Establish a connection to the server and log in. Returns a connection lifetime that will terminate if the connection /// terminates. -let signIn (logger: ILogger) (signInInfo: SignInInfo): Async = async { - let client = new XmppClient(JID(signInInfo.Login), signInInfo.Password) // TODO[F]: Add the logs back +let connect (logger: ILogger) (client: IXmppClient): Async = async { let connectionLifetime = new LifetimeDefinition() - client.add_ConnectionFailed <| XmppConnection.ConnectionFailedHandler( - fun _ error -> - logger.Error(error.Exception, "Connection failed: {Message}", error.Message) - connectionLifetime.Terminate() - ) - let! cancellationToken = Async.CancellationToken - use _ = cancellationToken.Register(fun () -> - logger.Information("Closing the connection due to external cancellation") - client.Close() - ) - do! Async.AwaitTask(client.ConnectAsync cancellationToken) // TODO[F]: Check if it will call the ConnectionFailed handler on cancellation - return client, connectionLifetime.Lifetime + client.AddConnectionFailedHandler connectionLifetime.Lifetime <| fun error -> + logger.Error(error.Exception, "Connection failed: {Message}", error.Message) + connectionLifetime.Terminate() + + do! client.Connect() + return connectionLifetime.Lifetime } let private addPresenceHandler (lifetime: Lifetime) (client: XmppClient) handler = @@ -90,6 +72,7 @@ let private addMessageHandler (lifetime: Lifetime) (client: XmppClient) handler lifetime.OnTermination(fun () -> client.remove_Message handlerDelegate) |> ignore /// Enter the room, returning the in-room lifetime. Will terminate if kicked or left the room. +/// TODO[F]: Write tests for this function. let enterRoom (client: XmppClient) (lifetime: Lifetime) (roomInfo: RoomInfo): Async = async { use connectionLifetimeDefinition = lifetime.CreateNested() let connectionLifetime = connectionLifetimeDefinition.Lifetime @@ -146,6 +129,7 @@ let private awaitMessageReceival (lifetime: Lifetime) client messageId = async { } /// Sends the message to the room. Returns an object that allows to track the message receival. +/// TODO[F]: Write tests for this function. let sendRoomMessage (lifetime: Lifetime) (client: XmppClient) (messageInfo: MessageInfo): Async = async { let messageId = Guid.NewGuid().ToString() // TODO[F]: Move to a new function @@ -159,5 +143,6 @@ let sendRoomMessage (lifetime: Lifetime) (client: XmppClient) (messageInfo: Mess } /// Waits for the message to be delivered. +/// TODO[F]: Write tests for this function. let awaitMessageDelivery (deliveryInfo: MessageDeliveryInfo): Async = deliveryInfo.Delivery diff --git a/Emulsion/Xmpp/XmppClient.fs b/Emulsion/Xmpp/XmppClient.fs index 4e126712..599ed38a 100644 --- a/Emulsion/Xmpp/XmppClient.fs +++ b/Emulsion/Xmpp/XmppClient.fs @@ -3,6 +3,7 @@ module Emulsion.Xmpp.XmppClient open System open System.Threading.Tasks +open JetBrains.Lifetimes open Serilog open SharpXMPP open SharpXMPP.XMPP @@ -10,7 +11,13 @@ open SharpXMPP.XMPP open Emulsion open Emulsion.Settings +// TODO[F]: Create an XmppClient-based implementation of this interface +type IXmppClient = + abstract member Connect: unit -> Async + abstract member AddConnectionFailedHandler: Lifetime -> (ConnFailedArgs -> unit) -> unit + // TODO[F]: This client should be removed +// TODO[F]: But preserve the logging routines; they're good let private connectionFailedHandler (logger: ILogger) = XmppConnection.ConnectionFailedHandler(fun s e -> logger.Error(e.Exception, "XMPP connection failed: {Message}", e.Message) ()) From 9451b7854ad70e76d1d93531cbe4b095b22e2bfd Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sat, 7 Sep 2019 19:12:53 +0700 Subject: [PATCH 09/22] Add tests for the enter function (#18) --- Emulsion.Tests/Xmpp/SharpXmppClientTests.fs | 111 ++++++++++++++++++++ Emulsion.Tests/Xmpp/XmppClientFactory.fs | 6 +- Emulsion/Xmpp/SharpXmppClient.fs | 50 ++++----- Emulsion/Xmpp/SharpXmppHelper.fs | 2 +- Emulsion/Xmpp/XmppClient.fs | 3 + Emulsion/Xmpp/XmppElements.fs | 2 +- 6 files changed, 141 insertions(+), 33 deletions(-) diff --git a/Emulsion.Tests/Xmpp/SharpXmppClientTests.fs b/Emulsion.Tests/Xmpp/SharpXmppClientTests.fs index 3872094e..0a95aa96 100644 --- a/Emulsion.Tests/Xmpp/SharpXmppClientTests.fs +++ b/Emulsion.Tests/Xmpp/SharpXmppClientTests.fs @@ -1,15 +1,57 @@ namespace Emulsion.Tests.Xmpp +open System + +open JetBrains.Lifetimes open SharpXMPP +open SharpXMPP.XMPP +open SharpXMPP.XMPP.Client.Elements open Xunit open Xunit.Abstractions +open System.Xml.Linq open Emulsion.Tests.TestUtils open Emulsion.Xmpp +open Emulsion.Xmpp.SharpXmppClient +open Emulsion.Xmpp.SharpXmppHelper.Attributes +open Emulsion.Xmpp.SharpXmppHelper.Elements type SharpXmppClientTests(testOutput: ITestOutputHelper) = let logger = Logging.xunitLogger testOutput + let createPresenceFor (roomJid: JID) nickname = + let presence = XMPPPresence() + let participantJid = JID(roomJid.FullJid) + participantJid.Resource <- nickname + presence.SetAttributeValue(From, participantJid.FullJid) + presence + + let createSelfPresence roomJid nickname = + let presence = createPresenceFor roomJid nickname + let x = XElement X + let status = XElement Status + status.SetAttributeValue(Code, "110") + x.Add status + presence.Add x + presence + + let createErrorPresence roomJid nickname errorXml = + let presence = createPresenceFor roomJid nickname + presence.SetAttributeValue(Type, "error") + let error = XElement Error + let errorChild = XElement.Parse errorXml + error.Add errorChild + presence.Add error + presence + + let createLeavePresence roomJid nickname = + let presence = createSelfPresence roomJid nickname + presence.SetAttributeValue(Type, "unavailable") + presence + + let sendPresence presence handlers = + Seq.iter (fun h -> h presence) handlers + [] member __.``connect function calls the Connect method of the client passed``(): unit = let mutable connectCalled = false @@ -26,3 +68,72 @@ type SharpXmppClientTests(testOutput: ITestOutputHelper) = Assert.True lt.IsAlive callback(ConnFailedArgs()) Assert.False lt.IsAlive + + [] + member __.``enter function calls JoinMultiUserChat``(): unit = + let mutable called = false + let mutable presenceHandlers = ResizeArray() + let client = + XmppClientFactory.create( + addPresenceHandler = (fun _ h -> presenceHandlers.Add h), + joinMultiUserChat = fun roomJid nickname -> + called <- true + Seq.iter (fun h -> h (createSelfPresence roomJid nickname)) presenceHandlers + ) + let roomInfo = { RoomJid = JID("room@conference.example.org"); Nickname = "testuser" } + Lifetime.Using(fun lt -> + Async.RunSynchronously <| SharpXmppClient.enterRoom client lt roomInfo |> ignore + Assert.True called + ) + + [] + member __.``enter throws an exception in case of an error presence``(): unit = + let mutable presenceHandlers = ResizeArray() + let client = + XmppClientFactory.create( + addPresenceHandler = (fun _ h -> presenceHandlers.Add h), + joinMultiUserChat = fun roomJid nickname -> + sendPresence (createErrorPresence roomJid nickname "") presenceHandlers + ) + let roomInfo = { RoomJid = JID("room@conference.example.org"); Nickname = "testuser" } + Lifetime.Using(fun lt -> + let ae = Assert.Throws(fun () -> + Async.RunSynchronously <| SharpXmppClient.enterRoom client lt roomInfo |> ignore + ) + let ex = Seq.exactlyOne ae.InnerExceptions + Assert.Contains("", ex.Message) + ) + + [] + member __.``Lifetime returned from enter terminates by a room leave presence``(): unit = + let mutable presenceHandlers = ResizeArray() + let client = + XmppClientFactory.create( + addPresenceHandler = (fun _ h -> presenceHandlers.Add h), + joinMultiUserChat = fun roomJid nickname -> + sendPresence (createSelfPresence roomJid nickname) presenceHandlers + ) + let roomInfo = { RoomJid = JID("room@conference.example.org"); Nickname = "testuser" } + Lifetime.Using(fun lt -> + let roomLt = Async.RunSynchronously <| SharpXmppClient.enterRoom client lt roomInfo + Assert.True roomLt.IsAlive + sendPresence (createLeavePresence roomInfo.RoomJid roomInfo.Nickname) presenceHandlers + Assert.False roomLt.IsAlive + ) + + [] + member __.``Lifetime returned from enter terminates by an external lifetime termination``(): unit = + let mutable presenceHandlers = ResizeArray() + let client = + XmppClientFactory.create( + addPresenceHandler = (fun _ h -> presenceHandlers.Add h), + joinMultiUserChat = fun roomJid nickname -> + sendPresence (createSelfPresence roomJid nickname) presenceHandlers + ) + let roomInfo = { RoomJid = JID("room@conference.example.org"); Nickname = "testuser" } + use ld = Lifetime.Define() + let lt = ld.Lifetime + let roomLt = Async.RunSynchronously <| SharpXmppClient.enterRoom client lt roomInfo + Assert.True roomLt.IsAlive + ld.Terminate() + Assert.False roomLt.IsAlive diff --git a/Emulsion.Tests/Xmpp/XmppClientFactory.fs b/Emulsion.Tests/Xmpp/XmppClientFactory.fs index 4805a12f..e327b313 100644 --- a/Emulsion.Tests/Xmpp/XmppClientFactory.fs +++ b/Emulsion.Tests/Xmpp/XmppClientFactory.fs @@ -3,10 +3,14 @@ namespace Emulsion.Tests.Xmpp open Emulsion.Xmpp.XmppClient type XmppClientFactory = - static member create(?connect, ?addConnectionFailedHandler): IXmppClient = + static member create(?connect, ?addConnectionFailedHandler, ?addPresenceHandler, ?joinMultiUserChat): IXmppClient = let connect = defaultArg connect <| fun () -> async { return () } let addConnectionFailedHandler = defaultArg addConnectionFailedHandler <| fun _ _ -> () + let addPresenceHandler = defaultArg addPresenceHandler <| fun _ _ -> () + let joinMultiUserChat = defaultArg joinMultiUserChat <| fun _ _ -> () { new IXmppClient with member __.Connect() = connect() member __.AddConnectionFailedHandler lt handler = addConnectionFailedHandler lt handler + member __.AddPresenceHandler lt handler = addPresenceHandler lt handler + member __.JoinMultiUserChat roomJid nickname = joinMultiUserChat roomJid nickname } diff --git a/Emulsion/Xmpp/SharpXmppClient.fs b/Emulsion/Xmpp/SharpXmppClient.fs index 7ec82629..9519af8a 100644 --- a/Emulsion/Xmpp/SharpXmppClient.fs +++ b/Emulsion/Xmpp/SharpXmppClient.fs @@ -11,16 +11,15 @@ open Emulsion open Emulsion.Lifetimes open Emulsion.Xmpp open Emulsion.Xmpp.XmppClient - -type Jid = string +open SharpXMPP.XMPP type RoomInfo = { - RoomJid: Jid + RoomJid: JID Nickname: string } type MessageInfo = { - RecipientJid: Jid + RecipientJid: JID Text: string } @@ -43,24 +42,19 @@ let connect (logger: ILogger) (client: IXmppClient): Async = async { return connectionLifetime.Lifetime } -let private addPresenceHandler (lifetime: Lifetime) (client: XmppClient) handler = - let handlerDelegate = XmppConnection.PresenceHandler(fun _ p -> handler p) - client.add_Presence handlerDelegate - lifetime.OnTermination (fun () -> client.remove_Presence handlerDelegate) |> ignore - let private isSelfPresence (roomInfo: RoomInfo) (presence: XMPPPresence) = let presence = SharpXmppHelper.parsePresence presence - let expectedJid = sprintf "%s/%s" roomInfo.RoomJid roomInfo.Nickname - presence.From = expectedJid && Array.contains 110 presence.States + let expectedJid = sprintf "%s/%s" roomInfo.RoomJid.BareJid roomInfo.Nickname + presence.Type = None && presence.From = expectedJid && Array.contains 110 presence.States let private isLeavePresence (roomInfo: RoomInfo) (presence: XMPPPresence) = let presence = SharpXmppHelper.parsePresence presence - let expectedJid = sprintf "%s/%s" roomInfo.RoomJid roomInfo.Nickname - presence.From = expectedJid && Array.contains 110 presence.States && presence.Type = "unavailable" + let expectedJid = sprintf "%s/%s" roomInfo.RoomJid.BareJid roomInfo.Nickname + presence.From = expectedJid && Array.contains 110 presence.States && presence.Type = Some "unavailable" let private extractException (roomInfo: RoomInfo) (presence: XMPPPresence) = let presence = SharpXmppHelper.parsePresence presence - let expectedJid = sprintf "%s/%s" roomInfo.RoomJid roomInfo.Nickname + let expectedJid = sprintf "%s/%s" roomInfo.RoomJid.BareJid roomInfo.Nickname if presence.From = expectedJid then presence.Error |> Option.map (fun e -> Exception(sprintf "Error: %A" e)) @@ -72,8 +66,7 @@ let private addMessageHandler (lifetime: Lifetime) (client: XmppClient) handler lifetime.OnTermination(fun () -> client.remove_Message handlerDelegate) |> ignore /// Enter the room, returning the in-room lifetime. Will terminate if kicked or left the room. -/// TODO[F]: Write tests for this function. -let enterRoom (client: XmppClient) (lifetime: Lifetime) (roomInfo: RoomInfo): Async = async { +let enterRoom (client: IXmppClient) (lifetime: Lifetime) (roomInfo: RoomInfo): Async = async { use connectionLifetimeDefinition = lifetime.CreateNested() let connectionLifetime = connectionLifetimeDefinition.Lifetime @@ -82,33 +75,30 @@ let enterRoom (client: XmppClient) (lifetime: Lifetime) (roomInfo: RoomInfo): As let tcs = nestedTaskCompletionSource connectionLifetime - // Enter room successfully handler: - addPresenceHandler connectionLifetime client (fun presence -> + // Success and error handlers: + client.AddPresenceHandler connectionLifetime (fun presence -> if isSelfPresence roomInfo presence then tcs.SetResult() - ) - - // Error handler: - addPresenceHandler connectionLifetime client (fun presence -> - match extractException roomInfo presence with - | Some ex -> tcs.SetException ex - | None -> () + else + match extractException roomInfo presence with + | Some ex -> tcs.SetException ex + | None -> () ) // Room leave handler: - addPresenceHandler roomLifetime client (fun presence -> + client.AddPresenceHandler roomLifetime (fun presence -> if isLeavePresence roomInfo presence then roomLifetimeDefinition.Terminate() ) try - // Start the enter process, wait for a result: - SharpXmppHelper.joinRoom client roomInfo.RoomJid roomInfo.Nickname + // Start the join process, wait for a result: + client.JoinMultiUserChat roomInfo.RoomJid roomInfo.Nickname do! Async.AwaitTask tcs.Task return roomLifetime with | ex -> - // In case of an error, terminate the room lifetime: + // In case of an error, terminate the room lifetime (but leave it intact in case of success): roomLifetimeDefinition.Terminate() return ExceptionUtils.reraise ex } @@ -133,7 +123,7 @@ let private awaitMessageReceival (lifetime: Lifetime) client messageId = async { let sendRoomMessage (lifetime: Lifetime) (client: XmppClient) (messageInfo: MessageInfo): Async = async { let messageId = Guid.NewGuid().ToString() // TODO[F]: Move to a new function - let message = SharpXmppHelper.message (Some messageId) messageInfo.RecipientJid messageInfo.Text + let message = SharpXmppHelper.message (Some messageId) messageInfo.RecipientJid.FullJid messageInfo.Text let! delivery = Async.StartChild <| awaitMessageReceival lifetime client messageId client.Send message return { diff --git a/Emulsion/Xmpp/SharpXmppHelper.fs b/Emulsion/Xmpp/SharpXmppHelper.fs index 286c77ba..7bcb44b9 100644 --- a/Emulsion/Xmpp/SharpXmppHelper.fs +++ b/Emulsion/Xmpp/SharpXmppHelper.fs @@ -96,7 +96,7 @@ let parseMessage (message: XMPPMessage): Message = let parsePresence(presence: XMPPPresence): Presence = let from = getAttributeValue presence From |> Option.defaultValue "" - let presenceType = getAttributeValue presence Type |> Option.defaultValue "" + let presenceType = getAttributeValue presence Type let states = presence.Element X |> Option.ofObj diff --git a/Emulsion/Xmpp/XmppClient.fs b/Emulsion/Xmpp/XmppClient.fs index 599ed38a..6e69a9b7 100644 --- a/Emulsion/Xmpp/XmppClient.fs +++ b/Emulsion/Xmpp/XmppClient.fs @@ -10,11 +10,14 @@ open SharpXMPP.XMPP open Emulsion open Emulsion.Settings +open SharpXMPP.XMPP.Client.Elements // TODO[F]: Create an XmppClient-based implementation of this interface type IXmppClient = abstract member Connect: unit -> Async abstract member AddConnectionFailedHandler: Lifetime -> (ConnFailedArgs -> unit) -> unit + abstract member AddPresenceHandler: Lifetime -> (XMPPPresence -> unit) -> unit + abstract member JoinMultiUserChat: roomJid: JID -> nickname: string -> unit // TODO[F]: This client should be removed // TODO[F]: But preserve the logging routines; they're good diff --git a/Emulsion/Xmpp/XmppElements.fs b/Emulsion/Xmpp/XmppElements.fs index b3d83cb0..10b80980 100644 --- a/Emulsion/Xmpp/XmppElements.fs +++ b/Emulsion/Xmpp/XmppElements.fs @@ -6,5 +6,5 @@ type Presence = { From: string States: int[] Error: XElement option - Type: string + Type: string option } From 68955c0f220c2d863e7d7375671191c680c804f8 Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sat, 7 Sep 2019 20:39:32 +0700 Subject: [PATCH 10/22] Add tests for the sendRoomMessage function (#18) --- Emulsion.Tests/Xmpp/SharpXmppClientTests.fs | 86 +++++++++++++++++++++ Emulsion.Tests/Xmpp/XmppClientFactory.fs | 15 +++- Emulsion/Xmpp/SharpXmppClient.fs | 42 +++++----- Emulsion/Xmpp/SharpXmppHelper.fs | 3 + Emulsion/Xmpp/XmppClient.fs | 4 +- 5 files changed, 127 insertions(+), 23 deletions(-) diff --git a/Emulsion.Tests/Xmpp/SharpXmppClientTests.fs b/Emulsion.Tests/Xmpp/SharpXmppClientTests.fs index 0a95aa96..4ec7cfc7 100644 --- a/Emulsion.Tests/Xmpp/SharpXmppClientTests.fs +++ b/Emulsion.Tests/Xmpp/SharpXmppClientTests.fs @@ -9,6 +9,7 @@ open SharpXMPP.XMPP.Client.Elements open Xunit open Xunit.Abstractions +open System.Threading.Tasks open System.Xml.Linq open Emulsion.Tests.TestUtils open Emulsion.Xmpp @@ -52,6 +53,18 @@ type SharpXmppClientTests(testOutput: ITestOutputHelper) = let sendPresence presence handlers = Seq.iter (fun h -> h presence) handlers + let createErrorMessage (message: XMPPMessage) errorXml = + // An error message is an exact copy of the original with the "error" element added: + let errorMessage = XMPPMessage() + message.Attributes() |> Seq.iter (fun a -> errorMessage.SetAttributeValue(a.Name, a.Value)) + message.Elements() |> Seq.iter (fun e -> errorMessage.Add e) + + let error = XElement Error + let errorChild = XElement.Parse errorXml + error.Add errorChild + errorMessage.Add error + errorMessage + [] member __.``connect function calls the Connect method of the client passed``(): unit = let mutable connectCalled = false @@ -137,3 +150,76 @@ type SharpXmppClientTests(testOutput: ITestOutputHelper) = Assert.True roomLt.IsAlive ld.Terminate() Assert.False roomLt.IsAlive + + [] + member __.``sendRoomMessage calls Send method on the client``(): unit = + let mutable message = Unchecked.defaultof + let client = XmppClientFactory.create(send = fun m -> message <- m) + let messageInfo = { RecipientJid = JID("room@conference.example.org"); Text = "foo bar" } + Lifetime.Using(fun lt -> + Async.RunSynchronously <| SharpXmppClient.sendRoomMessage client lt messageInfo |> ignore + Assert.Equal(messageInfo.RecipientJid.FullJid, message.To.FullJid) + Assert.Equal(messageInfo.Text, message.Text) + ) + + [] + member __.``sendRoomMessage's result gets resolved after the message receival``(): unit = + let mutable messageHandler = ignore + let mutable message = Unchecked.defaultof + let client = + XmppClientFactory.create( + addMessageHandler = (fun _ h -> messageHandler <- h), + send = fun m -> message <- m + ) + let messageInfo = { RecipientJid = JID("room@conference.example.org"); Text = "foo bar" } + Lifetime.Using(fun lt -> + let deliveryInfo = Async.RunSynchronously <| SharpXmppClient.sendRoomMessage client lt messageInfo + Assert.Equal(message.ID, deliveryInfo.MessageId) + let deliveryTask = Async.StartAsTask deliveryInfo.Delivery + Assert.False deliveryTask.IsCompleted + messageHandler message + deliveryTask.Wait() + ) + + [] + member __.``sendRoomMessage's result doesn't get resolved after receiving other message``(): unit = + let mutable messageHandler = ignore + let client = XmppClientFactory.create(addMessageHandler = fun _ h -> messageHandler <- h) + let messageInfo = { RecipientJid = JID("room@conference.example.org"); Text = "foo bar" } + Lifetime.Using(fun lt -> + let deliveryInfo = Async.RunSynchronously <| SharpXmppClient.sendRoomMessage client lt messageInfo + let deliveryTask = Async.StartAsTask deliveryInfo.Delivery + Assert.False deliveryTask.IsCompleted + + let otherMessage = SharpXmppHelper.message (Some "xxx") "nickname@example.org" "foo bar" + messageHandler otherMessage + Assert.False deliveryTask.IsCompleted + ) + + [] + member __.``sendRoomMessage's result gets resolved with an error if an error response is received``(): unit = + let mutable messageHandler = ignore + let client = + XmppClientFactory.create( + addMessageHandler = (fun _ h -> messageHandler <- h), + send = fun m -> messageHandler(createErrorMessage m "") + ) + let messageInfo = { RecipientJid = JID("room@conference.example.org"); Text = "foo bar" } + Lifetime.Using(fun lt -> + let deliveryInfo = Async.RunSynchronously <| SharpXmppClient.sendRoomMessage client lt messageInfo + let ae = Assert.Throws(fun () -> Async.RunSynchronously deliveryInfo.Delivery) + let ex = Seq.exactlyOne ae.InnerExceptions + Assert.Contains("", ex.Message) + ) + + [] + member __.``sendRoomMessage's result gets terminated after parent lifetime termination``(): unit = + let client = XmppClientFactory.create() + let messageInfo = { RecipientJid = JID("room@conference.example.org"); Text = "foo bar" } + use ld = Lifetime.Define() + let lt = ld.Lifetime + let deliveryInfo = Async.RunSynchronously <| SharpXmppClient.sendRoomMessage client lt messageInfo + let deliveryTask = Async.StartAsTask deliveryInfo.Delivery + Assert.False deliveryTask.IsCompleted + ld.Terminate() + Assert.Throws(fun () -> deliveryTask.GetAwaiter().GetResult()) |> ignore diff --git a/Emulsion.Tests/Xmpp/XmppClientFactory.fs b/Emulsion.Tests/Xmpp/XmppClientFactory.fs index e327b313..aa9a0f07 100644 --- a/Emulsion.Tests/Xmpp/XmppClientFactory.fs +++ b/Emulsion.Tests/Xmpp/XmppClientFactory.fs @@ -3,14 +3,23 @@ namespace Emulsion.Tests.Xmpp open Emulsion.Xmpp.XmppClient type XmppClientFactory = - static member create(?connect, ?addConnectionFailedHandler, ?addPresenceHandler, ?joinMultiUserChat): IXmppClient = + 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 joinMultiUserChat = defaultArg joinMultiUserChat <| 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 __.AddPresenceHandler lt handler = addPresenceHandler lt handler - member __.JoinMultiUserChat roomJid nickname = joinMultiUserChat roomJid nickname + member __.AddMessageHandler lt handler = addMessageHandler lt handler } diff --git a/Emulsion/Xmpp/SharpXmppClient.fs b/Emulsion/Xmpp/SharpXmppClient.fs index 9519af8a..928b8cc8 100644 --- a/Emulsion/Xmpp/SharpXmppClient.fs +++ b/Emulsion/Xmpp/SharpXmppClient.fs @@ -4,14 +4,13 @@ open System open JetBrains.Lifetimes open Serilog -open SharpXMPP +open SharpXMPP.XMPP open SharpXMPP.XMPP.Client.Elements open Emulsion open Emulsion.Lifetimes open Emulsion.Xmpp open Emulsion.Xmpp.XmppClient -open SharpXMPP.XMPP type RoomInfo = { RoomJid: JID @@ -52,7 +51,7 @@ let private isLeavePresence (roomInfo: RoomInfo) (presence: XMPPPresence) = let expectedJid = sprintf "%s/%s" roomInfo.RoomJid.BareJid roomInfo.Nickname presence.From = expectedJid && Array.contains 110 presence.States && presence.Type = Some "unavailable" -let private extractException (roomInfo: RoomInfo) (presence: XMPPPresence) = +let private extractPresenceException (roomInfo: RoomInfo) (presence: XMPPPresence) = let presence = SharpXmppHelper.parsePresence presence let expectedJid = sprintf "%s/%s" roomInfo.RoomJid.BareJid roomInfo.Nickname if presence.From = expectedJid then @@ -60,11 +59,6 @@ let private extractException (roomInfo: RoomInfo) (presence: XMPPPresence) = |> Option.map (fun e -> Exception(sprintf "Error: %A" e)) else None -let private addMessageHandler (lifetime: Lifetime) (client: XmppClient) handler = - let handlerDelegate = XmppConnection.MessageHandler handler - client.add_Message handlerDelegate - lifetime.OnTermination(fun () -> client.remove_Message handlerDelegate) |> ignore - /// Enter the room, returning the in-room lifetime. Will terminate if kicked or left the room. let enterRoom (client: IXmppClient) (lifetime: Lifetime) (roomInfo: RoomInfo): Async = async { use connectionLifetimeDefinition = lifetime.CreateNested() @@ -80,7 +74,7 @@ let enterRoom (client: IXmppClient) (lifetime: Lifetime) (roomInfo: RoomInfo): A if isSelfPresence roomInfo presence then tcs.SetResult() else - match extractException roomInfo presence with + match extractPresenceException roomInfo presence with | Some ex -> tcs.SetException ex | None -> () ) @@ -106,25 +100,35 @@ let enterRoom (client: IXmppClient) (lifetime: Lifetime) (roomInfo: RoomInfo): A let private hasMessageId messageId message = SharpXmppHelper.getMessageId message = Some messageId -let private awaitMessageReceival (lifetime: Lifetime) client messageId = async { - use messageLifetimeDefinition = lifetime.CreateNested() +let private extractMessageException message = + SharpXmppHelper.getMessageError message + |> Option.map(fun e -> Exception(sprintf "Error: %A" e)) + +let private awaitMessageReceival (client: IXmppClient) (lifetime: Lifetime) messageId = + // We need to perform this part synchronously to avoid the race condition between adding a message handler and + // actually sending a message. + let messageLifetimeDefinition = lifetime.CreateNested() let messageLifetime = messageLifetimeDefinition.Lifetime let messageReceivedTask = nestedTaskCompletionSource messageLifetime - addMessageHandler lifetime client (fun _ message -> + client.AddMessageHandler lifetime (fun message -> if hasMessageId messageId message then - messageReceivedTask.SetResult() + match extractMessageException message with + | Some ex -> messageReceivedTask.SetException ex + | None -> messageReceivedTask.SetResult() ) - - do! Async.AwaitTask messageReceivedTask.Task -} + async { + try + do! Async.AwaitTask messageReceivedTask.Task + finally + messageLifetimeDefinition.Dispose() + } /// Sends the message to the room. Returns an object that allows to track the message receival. -/// TODO[F]: Write tests for this function. -let sendRoomMessage (lifetime: Lifetime) (client: XmppClient) (messageInfo: MessageInfo): Async = +let sendRoomMessage (client: IXmppClient) (lifetime: Lifetime) (messageInfo: MessageInfo): Async = async { let messageId = Guid.NewGuid().ToString() // TODO[F]: Move to a new function let message = SharpXmppHelper.message (Some messageId) messageInfo.RecipientJid.FullJid messageInfo.Text - let! delivery = Async.StartChild <| awaitMessageReceival lifetime client messageId + let! delivery = Async.StartChild <| awaitMessageReceival client lifetime messageId client.Send message return { MessageId = messageId diff --git a/Emulsion/Xmpp/SharpXmppHelper.fs b/Emulsion/Xmpp/SharpXmppHelper.fs index 7bcb44b9..999a2e1e 100644 --- a/Emulsion/Xmpp/SharpXmppHelper.fs +++ b/Emulsion/Xmpp/SharpXmppHelper.fs @@ -87,6 +87,9 @@ let isEmptyMessage(message: XMPPMessage): bool = let getMessageId(message: XMPPMessage): string option = getAttributeValue message Id +let getMessageError(message: XMPPMessage): XElement option = + message.Element Error |> Option.ofObj + let parseMessage (message: XMPPMessage): Message = let nickname = getAttributeValue message From diff --git a/Emulsion/Xmpp/XmppClient.fs b/Emulsion/Xmpp/XmppClient.fs index 6e69a9b7..4c0ed0d3 100644 --- a/Emulsion/Xmpp/XmppClient.fs +++ b/Emulsion/Xmpp/XmppClient.fs @@ -15,9 +15,11 @@ open SharpXMPP.XMPP.Client.Elements // TODO[F]: Create an XmppClient-based implementation of this interface type IXmppClient = abstract member Connect: unit -> Async + abstract member JoinMultiUserChat: roomJid: JID -> nickname: string -> unit + abstract member Send: XMPPMessage -> unit abstract member AddConnectionFailedHandler: Lifetime -> (ConnFailedArgs -> unit) -> unit abstract member AddPresenceHandler: Lifetime -> (XMPPPresence -> unit) -> unit - abstract member JoinMultiUserChat: roomJid: JID -> nickname: string -> unit + abstract member AddMessageHandler: Lifetime -> (XMPPMessage -> unit) -> unit // TODO[F]: This client should be removed // TODO[F]: But preserve the logging routines; they're good From e79f39dd159ccb25915fa5eb6cf586a26dbee3e8 Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sat, 7 Sep 2019 20:44:51 +0700 Subject: [PATCH 11/22] Add a test for the awaitMessageDelivery function (#18) --- Emulsion.Tests/Xmpp/SharpXmppClientTests.fs | 7 +++++++ Emulsion/Xmpp/SharpXmppClient.fs | 1 - 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/Emulsion.Tests/Xmpp/SharpXmppClientTests.fs b/Emulsion.Tests/Xmpp/SharpXmppClientTests.fs index 4ec7cfc7..fa9017f2 100644 --- a/Emulsion.Tests/Xmpp/SharpXmppClientTests.fs +++ b/Emulsion.Tests/Xmpp/SharpXmppClientTests.fs @@ -223,3 +223,10 @@ type SharpXmppClientTests(testOutput: ITestOutputHelper) = Assert.False deliveryTask.IsCompleted ld.Terminate() Assert.Throws(fun () -> deliveryTask.GetAwaiter().GetResult()) |> ignore + + [] + member __.``awaitMessageDelivery just returns an async from the delivery info``(): unit = + let async = async { return () } + let deliveryInfo = { MessageId = ""; Delivery = async } + let result = awaitMessageDelivery deliveryInfo + Assert.True(Object.ReferenceEquals(async, result)) diff --git a/Emulsion/Xmpp/SharpXmppClient.fs b/Emulsion/Xmpp/SharpXmppClient.fs index 928b8cc8..12f863d0 100644 --- a/Emulsion/Xmpp/SharpXmppClient.fs +++ b/Emulsion/Xmpp/SharpXmppClient.fs @@ -137,6 +137,5 @@ let sendRoomMessage (client: IXmppClient) (lifetime: Lifetime) (messageInfo: Mes } /// Waits for the message to be delivered. -/// TODO[F]: Write tests for this function. let awaitMessageDelivery (deliveryInfo: MessageDeliveryInfo): Async = deliveryInfo.Delivery From beacbe80705e45da37cea731ec4bd8daec68d6fc Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sat, 7 Sep 2019 20:57:23 +0700 Subject: [PATCH 12/22] Add an XmppClient-based implementation for IXmppClient (#18) --- Emulsion/Xmpp/XmppClient.fs | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) diff --git a/Emulsion/Xmpp/XmppClient.fs b/Emulsion/Xmpp/XmppClient.fs index 4c0ed0d3..e375da36 100644 --- a/Emulsion/Xmpp/XmppClient.fs +++ b/Emulsion/Xmpp/XmppClient.fs @@ -12,7 +12,6 @@ open Emulsion open Emulsion.Settings open SharpXMPP.XMPP.Client.Elements -// TODO[F]: Create an XmppClient-based implementation of this interface type IXmppClient = abstract member Connect: unit -> Async abstract member JoinMultiUserChat: roomJid: JID -> nickname: string -> unit @@ -21,6 +20,27 @@ type IXmppClient = abstract member AddPresenceHandler: Lifetime -> (XMPPPresence -> unit) -> unit abstract member AddMessageHandler: Lifetime -> (XMPPMessage -> unit) -> unit +type SharpXmppClient(client: XmppClient) = + interface IXmppClient with + member ___.Connect() = async { + let! ct = Async.CancellationToken + return! Async.AwaitTask(client.ConnectAsync ct) + } + member __.JoinMultiUserChat roomJid nickname = SharpXmppHelper.joinRoom client roomJid.BareJid nickname + member __.Send message = client.Send message + member __.AddConnectionFailedHandler lt handler = + let handlerDelegate = XmppClient.ConnectionFailedHandler(fun _ args -> handler args) + client.add_ConnectionFailed handlerDelegate + lt.OnTermination(fun () -> client.remove_ConnectionFailed handlerDelegate) |> ignore + member __.AddPresenceHandler lt handler = + let handlerDelegate = XmppClient.PresenceHandler(fun _ args -> handler args) + client.add_Presence handlerDelegate + lt.OnTermination(fun () -> client.remove_Presence handlerDelegate) |> ignore + member __.AddMessageHandler lt handler = + let handlerDelegate = XmppClient.MessageHandler(fun _ args -> handler args) + client.add_Message handlerDelegate + lt.OnTermination(fun () -> client.remove_Message handlerDelegate) |> ignore + // TODO[F]: This client should be removed // TODO[F]: But preserve the logging routines; they're good let private connectionFailedHandler (logger: ILogger) = XmppConnection.ConnectionFailedHandler(fun s e -> From 69ed8e36cf7c90876d9f6e5577e085ca99f4cbd0 Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sat, 7 Sep 2019 22:08:19 +0700 Subject: [PATCH 13/22] Migrate to the IXmppClient-based XMPP implementation (#18) --- Emulsion.Tests/Emulsion.Tests.fsproj | 2 +- Emulsion.Tests/Xmpp/XmppClientFactory.fs | 2 + ...pXmppClientTests.fs => XmppClientTests.fs} | 31 ++- Emulsion/Emulsion.fsproj | 7 +- Emulsion/Lifetimes.fs | 5 + Emulsion/Program.fs | 3 +- Emulsion/Xmpp/EmulsionXmpp.fs | 65 ++++++ Emulsion/Xmpp/SharpXmppClient.fs | 169 ++++----------- Emulsion/Xmpp/SharpXmppHelper.fs | 3 +- Emulsion/Xmpp/Types.fs | 29 +++ Emulsion/Xmpp/XmppClient.fs | 195 ++++++++++-------- Emulsion/Xmpp/XmppElements.fs | 10 - .../Xmpp/{Client.fs => XmppMessageSystem.fs} | 11 +- 13 files changed, 274 insertions(+), 258 deletions(-) rename Emulsion.Tests/Xmpp/{SharpXmppClientTests.fs => XmppClientTests.fs} (88%) create mode 100644 Emulsion/Xmpp/EmulsionXmpp.fs create mode 100644 Emulsion/Xmpp/Types.fs delete mode 100644 Emulsion/Xmpp/XmppElements.fs rename Emulsion/Xmpp/{Client.fs => XmppMessageSystem.fs} (56%) diff --git a/Emulsion.Tests/Emulsion.Tests.fsproj b/Emulsion.Tests/Emulsion.Tests.fsproj index 407a72e2..8896644f 100644 --- a/Emulsion.Tests/Emulsion.Tests.fsproj +++ b/Emulsion.Tests/Emulsion.Tests.fsproj @@ -19,7 +19,7 @@ - + diff --git a/Emulsion.Tests/Xmpp/XmppClientFactory.fs b/Emulsion.Tests/Xmpp/XmppClientFactory.fs index aa9a0f07..410a3278 100644 --- a/Emulsion.Tests/Xmpp/XmppClientFactory.fs +++ b/Emulsion.Tests/Xmpp/XmppClientFactory.fs @@ -20,6 +20,8 @@ type XmppClientFactory = 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 } diff --git a/Emulsion.Tests/Xmpp/SharpXmppClientTests.fs b/Emulsion.Tests/Xmpp/XmppClientTests.fs similarity index 88% rename from Emulsion.Tests/Xmpp/SharpXmppClientTests.fs rename to Emulsion.Tests/Xmpp/XmppClientTests.fs index fa9017f2..eb14865d 100644 --- a/Emulsion.Tests/Xmpp/SharpXmppClientTests.fs +++ b/Emulsion.Tests/Xmpp/XmppClientTests.fs @@ -1,6 +1,8 @@ namespace Emulsion.Tests.Xmpp open System +open System.Threading.Tasks +open System.Xml.Linq open JetBrains.Lifetimes open SharpXMPP @@ -9,15 +11,12 @@ open SharpXMPP.XMPP.Client.Elements open Xunit open Xunit.Abstractions -open System.Threading.Tasks -open System.Xml.Linq open Emulsion.Tests.TestUtils open Emulsion.Xmpp -open Emulsion.Xmpp.SharpXmppClient open Emulsion.Xmpp.SharpXmppHelper.Attributes open Emulsion.Xmpp.SharpXmppHelper.Elements -type SharpXmppClientTests(testOutput: ITestOutputHelper) = +type XmppClientTests(testOutput: ITestOutputHelper) = let logger = Logging.xunitLogger testOutput let createPresenceFor (roomJid: JID) nickname = @@ -69,7 +68,7 @@ type SharpXmppClientTests(testOutput: ITestOutputHelper) = member __.``connect function calls the Connect method of the client passed``(): unit = let mutable connectCalled = false let client = XmppClientFactory.create(fun () -> async { connectCalled <- true }) - Async.RunSynchronously <| SharpXmppClient.connect logger client |> ignore + Async.RunSynchronously <| XmppClient.connect logger client |> ignore Assert.True connectCalled [] @@ -77,7 +76,7 @@ type SharpXmppClientTests(testOutput: ITestOutputHelper) = : unit = let mutable callback = ignore let client = XmppClientFactory.create(addConnectionFailedHandler = fun _ h -> callback <- h) - let lt = Async.RunSynchronously <| SharpXmppClient.connect logger client + let lt = Async.RunSynchronously <| XmppClient.connect logger client Assert.True lt.IsAlive callback(ConnFailedArgs()) Assert.False lt.IsAlive @@ -95,7 +94,7 @@ type SharpXmppClientTests(testOutput: ITestOutputHelper) = ) let roomInfo = { RoomJid = JID("room@conference.example.org"); Nickname = "testuser" } Lifetime.Using(fun lt -> - Async.RunSynchronously <| SharpXmppClient.enterRoom client lt roomInfo |> ignore + Async.RunSynchronously <| XmppClient.enterRoom client lt roomInfo |> ignore Assert.True called ) @@ -111,7 +110,7 @@ type SharpXmppClientTests(testOutput: ITestOutputHelper) = let roomInfo = { RoomJid = JID("room@conference.example.org"); Nickname = "testuser" } Lifetime.Using(fun lt -> let ae = Assert.Throws(fun () -> - Async.RunSynchronously <| SharpXmppClient.enterRoom client lt roomInfo |> ignore + Async.RunSynchronously <| XmppClient.enterRoom client lt roomInfo |> ignore ) let ex = Seq.exactlyOne ae.InnerExceptions Assert.Contains("", ex.Message) @@ -128,7 +127,7 @@ type SharpXmppClientTests(testOutput: ITestOutputHelper) = ) let roomInfo = { RoomJid = JID("room@conference.example.org"); Nickname = "testuser" } Lifetime.Using(fun lt -> - let roomLt = Async.RunSynchronously <| SharpXmppClient.enterRoom client lt roomInfo + let roomLt = Async.RunSynchronously <| XmppClient.enterRoom client lt roomInfo Assert.True roomLt.IsAlive sendPresence (createLeavePresence roomInfo.RoomJid roomInfo.Nickname) presenceHandlers Assert.False roomLt.IsAlive @@ -146,7 +145,7 @@ type SharpXmppClientTests(testOutput: ITestOutputHelper) = let roomInfo = { RoomJid = JID("room@conference.example.org"); Nickname = "testuser" } use ld = Lifetime.Define() let lt = ld.Lifetime - let roomLt = Async.RunSynchronously <| SharpXmppClient.enterRoom client lt roomInfo + let roomLt = Async.RunSynchronously <| XmppClient.enterRoom client lt roomInfo Assert.True roomLt.IsAlive ld.Terminate() Assert.False roomLt.IsAlive @@ -157,7 +156,7 @@ type SharpXmppClientTests(testOutput: ITestOutputHelper) = let client = XmppClientFactory.create(send = fun m -> message <- m) let messageInfo = { RecipientJid = JID("room@conference.example.org"); Text = "foo bar" } Lifetime.Using(fun lt -> - Async.RunSynchronously <| SharpXmppClient.sendRoomMessage client lt messageInfo |> ignore + Async.RunSynchronously <| XmppClient.sendRoomMessage client lt messageInfo |> ignore Assert.Equal(messageInfo.RecipientJid.FullJid, message.To.FullJid) Assert.Equal(messageInfo.Text, message.Text) ) @@ -173,7 +172,7 @@ type SharpXmppClientTests(testOutput: ITestOutputHelper) = ) let messageInfo = { RecipientJid = JID("room@conference.example.org"); Text = "foo bar" } Lifetime.Using(fun lt -> - let deliveryInfo = Async.RunSynchronously <| SharpXmppClient.sendRoomMessage client lt messageInfo + let deliveryInfo = Async.RunSynchronously <| XmppClient.sendRoomMessage client lt messageInfo Assert.Equal(message.ID, deliveryInfo.MessageId) let deliveryTask = Async.StartAsTask deliveryInfo.Delivery Assert.False deliveryTask.IsCompleted @@ -187,7 +186,7 @@ type SharpXmppClientTests(testOutput: ITestOutputHelper) = let client = XmppClientFactory.create(addMessageHandler = fun _ h -> messageHandler <- h) let messageInfo = { RecipientJid = JID("room@conference.example.org"); Text = "foo bar" } Lifetime.Using(fun lt -> - let deliveryInfo = Async.RunSynchronously <| SharpXmppClient.sendRoomMessage client lt messageInfo + let deliveryInfo = Async.RunSynchronously <| XmppClient.sendRoomMessage client lt messageInfo let deliveryTask = Async.StartAsTask deliveryInfo.Delivery Assert.False deliveryTask.IsCompleted @@ -206,7 +205,7 @@ type SharpXmppClientTests(testOutput: ITestOutputHelper) = ) let messageInfo = { RecipientJid = JID("room@conference.example.org"); Text = "foo bar" } Lifetime.Using(fun lt -> - let deliveryInfo = Async.RunSynchronously <| SharpXmppClient.sendRoomMessage client lt messageInfo + let deliveryInfo = Async.RunSynchronously <| XmppClient.sendRoomMessage client lt messageInfo let ae = Assert.Throws(fun () -> Async.RunSynchronously deliveryInfo.Delivery) let ex = Seq.exactlyOne ae.InnerExceptions Assert.Contains("", ex.Message) @@ -218,7 +217,7 @@ type SharpXmppClientTests(testOutput: ITestOutputHelper) = let messageInfo = { RecipientJid = JID("room@conference.example.org"); Text = "foo bar" } use ld = Lifetime.Define() let lt = ld.Lifetime - let deliveryInfo = Async.RunSynchronously <| SharpXmppClient.sendRoomMessage client lt messageInfo + let deliveryInfo = Async.RunSynchronously <| XmppClient.sendRoomMessage client lt messageInfo let deliveryTask = Async.StartAsTask deliveryInfo.Delivery Assert.False deliveryTask.IsCompleted ld.Terminate() @@ -228,5 +227,5 @@ type SharpXmppClientTests(testOutput: ITestOutputHelper) = member __.``awaitMessageDelivery just returns an async from the delivery info``(): unit = let async = async { return () } let deliveryInfo = { MessageId = ""; Delivery = async } - let result = awaitMessageDelivery deliveryInfo + let result = XmppClient.awaitMessageDelivery deliveryInfo Assert.True(Object.ReferenceEquals(async, result)) diff --git a/Emulsion/Emulsion.fsproj b/Emulsion/Emulsion.fsproj index 1969a66c..a5551a6d 100644 --- a/Emulsion/Emulsion.fsproj +++ b/Emulsion/Emulsion.fsproj @@ -16,11 +16,12 @@ - + - + - + + diff --git a/Emulsion/Lifetimes.fs b/Emulsion/Lifetimes.fs index 34a01f11..3a31ec4a 100644 --- a/Emulsion/Lifetimes.fs +++ b/Emulsion/Lifetimes.fs @@ -15,3 +15,8 @@ let nestedTaskCompletionSource<'T>(lifetime: Lifetime): TaskCompletionSource<'T> tcs.Task.ContinueWith(fun (t: Task<'T>) -> action.Dispose()) |> ignore tcs + +let awaitTermination(lifetime: Lifetime): Async = + let tcs = TaskCompletionSource() + lifetime.OnTermination(fun () -> tcs.SetResult()) |> ignore + Async.AwaitTask tcs.Task diff --git a/Emulsion/Program.fs b/Emulsion/Program.fs index 3e5ac016..456c2ce4 100644 --- a/Emulsion/Program.fs +++ b/Emulsion/Program.fs @@ -10,6 +10,7 @@ open Serilog open Emulsion.Actors open Emulsion.MessageSystem open Emulsion.Settings +open Emulsion.Xmpp let private getConfiguration directory fileName = let config = @@ -47,7 +48,7 @@ let private startApp config = let telegramLogger = Logging.telegramLogger logger let! cancellationToken = Async.CancellationToken - let xmpp = createClient xmppLogger Xmpp.Client cancellationToken config.Xmpp + let xmpp = createClient xmppLogger XmppMessageSystem cancellationToken config.Xmpp let telegram = createClient telegramLogger Telegram.Client cancellationToken config.Telegram let factories = { xmppFactory = Xmpp.spawn xmppLogger xmpp telegramFactory = Telegram.spawn telegramLogger telegram } diff --git a/Emulsion/Xmpp/EmulsionXmpp.fs b/Emulsion/Xmpp/EmulsionXmpp.fs new file mode 100644 index 00000000..da6e7712 --- /dev/null +++ b/Emulsion/Xmpp/EmulsionXmpp.fs @@ -0,0 +1,65 @@ +/// Main business logic for an XMPP part of the Emulsion application. +/// TODO[F]: Add tests for this module. +module Emulsion.Xmpp.EmulsionXmpp + +open JetBrains.Lifetimes +open Serilog +open SharpXMPP.XMPP + +open Emulsion +open Emulsion.Settings +open Emulsion.MessageSystem +open Emulsion.Xmpp.XmppClient + +let private shouldProcessMessage (settings: XmppSettings) message = + let isGroup = SharpXmppHelper.isGroupChatMessage message + let shouldSkip = lazy ( + SharpXmppHelper.isOwnMessage (settings.Nickname) message + || SharpXmppHelper.isHistoricalMessage message + || SharpXmppHelper.isEmptyMessage message + ) + isGroup && not shouldSkip.Value + +let private addMessageHandler settings lt (client: IXmppClient) receiver = + client.AddMessageHandler lt (fun xmppMessage -> + if shouldProcessMessage settings xmppMessage then + let message = SharpXmppHelper.parseMessage xmppMessage + receiver(XmppMessage message) + ) + +let initializeLogging (logger: ILogger) (client: IXmppClient): IXmppClient = + let lt = Lifetime.Eternal + client.AddConnectionFailedHandler lt (fun e -> logger.Error(e.Exception, "Connection failed: {Message}", e.Message)) + client.AddSignedInHandler lt (fun e -> logger.Information("Signed in to the server")) + client.AddElementHandler lt (fun e -> + let direction = if e.IsInput then "incoming" else "outgoing" + logger.Verbose("XMPP stanza ({Direction}): {Stanza}", direction, e.Stanza) + ) + client + +let run (settings: XmppSettings) + (logger: ILogger) + (client: IXmppClient) + (messageReceiver: IncomingMessageReceiver): Async = async { + logger.Information "Connecting to the server" + let! sessionLifetime = XmppClient.connect logger client + logger.Information "Connection succeeded" + + logger.Information "Initializing client handler" + addMessageHandler settings sessionLifetime client messageReceiver + logger.Information "Client handler initialized" + + let roomInfo = { RoomJid = JID(settings.Room); Nickname = settings.Nickname } + logger.Information("Entering the room {RoomInfo}", roomInfo) + let! roomLifetime = XmppClient.enterRoom client sessionLifetime roomInfo + logger.Information "Entered the room" + + logger.Information "Ready, waiting for room lifetime termination" + do! Lifetimes.awaitTermination roomLifetime + logger.Information "Room lifetime has been terminated" +} + +let send (settings: XmppSettings) (client: IXmppClient) (message: Message): unit = + let text = sprintf "<%s> %s" message.author message.text + SharpXmppHelper.message None settings.Room text + |> client.Send diff --git a/Emulsion/Xmpp/SharpXmppClient.fs b/Emulsion/Xmpp/SharpXmppClient.fs index 12f863d0..0767cbf1 100644 --- a/Emulsion/Xmpp/SharpXmppClient.fs +++ b/Emulsion/Xmpp/SharpXmppClient.fs @@ -1,141 +1,44 @@ +/// An implementation of an IXmppClient based on SharpXMPP library. module Emulsion.Xmpp.SharpXmppClient -open System - -open JetBrains.Lifetimes -open Serilog +open SharpXMPP open SharpXMPP.XMPP -open SharpXMPP.XMPP.Client.Elements -open Emulsion -open Emulsion.Lifetimes open Emulsion.Xmpp open Emulsion.Xmpp.XmppClient +open Emulsion.Settings -type RoomInfo = { - RoomJid: JID - Nickname: string -} - -type MessageInfo = { - RecipientJid: JID - Text: string -} - -type MessageDeliveryInfo = { - MessageId: string - - /// Resolves after the message is guaranteed to be delivered to the recipient. - Delivery: Async -} - -/// Establish a connection to the server and log in. Returns a connection lifetime that will terminate if the connection -/// terminates. -let connect (logger: ILogger) (client: IXmppClient): Async = async { - let connectionLifetime = new LifetimeDefinition() - client.AddConnectionFailedHandler connectionLifetime.Lifetime <| fun error -> - logger.Error(error.Exception, "Connection failed: {Message}", error.Message) - connectionLifetime.Terminate() - - do! client.Connect() - return connectionLifetime.Lifetime -} - -let private isSelfPresence (roomInfo: RoomInfo) (presence: XMPPPresence) = - let presence = SharpXmppHelper.parsePresence presence - let expectedJid = sprintf "%s/%s" roomInfo.RoomJid.BareJid roomInfo.Nickname - presence.Type = None && presence.From = expectedJid && Array.contains 110 presence.States - -let private isLeavePresence (roomInfo: RoomInfo) (presence: XMPPPresence) = - let presence = SharpXmppHelper.parsePresence presence - let expectedJid = sprintf "%s/%s" roomInfo.RoomJid.BareJid roomInfo.Nickname - presence.From = expectedJid && Array.contains 110 presence.States && presence.Type = Some "unavailable" - -let private extractPresenceException (roomInfo: RoomInfo) (presence: XMPPPresence) = - let presence = SharpXmppHelper.parsePresence presence - let expectedJid = sprintf "%s/%s" roomInfo.RoomJid.BareJid roomInfo.Nickname - if presence.From = expectedJid then - presence.Error - |> Option.map (fun e -> Exception(sprintf "Error: %A" e)) - else None - -/// Enter the room, returning the in-room lifetime. Will terminate if kicked or left the room. -let enterRoom (client: IXmppClient) (lifetime: Lifetime) (roomInfo: RoomInfo): Async = async { - use connectionLifetimeDefinition = lifetime.CreateNested() - let connectionLifetime = connectionLifetimeDefinition.Lifetime - - let roomLifetimeDefinition = lifetime.CreateNested() - let roomLifetime = roomLifetimeDefinition.Lifetime - - let tcs = nestedTaskCompletionSource connectionLifetime - - // Success and error handlers: - client.AddPresenceHandler connectionLifetime (fun presence -> - if isSelfPresence roomInfo presence - then tcs.SetResult() - else - match extractPresenceException roomInfo presence with - | Some ex -> tcs.SetException ex - | None -> () - ) - - // Room leave handler: - client.AddPresenceHandler roomLifetime (fun presence -> - if isLeavePresence roomInfo presence - then roomLifetimeDefinition.Terminate() - ) - - try - // Start the join process, wait for a result: - client.JoinMultiUserChat roomInfo.RoomJid roomInfo.Nickname - do! Async.AwaitTask tcs.Task - return roomLifetime - with - | ex -> - // In case of an error, terminate the room lifetime (but leave it intact in case of success): - roomLifetimeDefinition.Terminate() - return ExceptionUtils.reraise ex -} - -let private hasMessageId messageId message = - SharpXmppHelper.getMessageId message = Some messageId - -let private extractMessageException message = - SharpXmppHelper.getMessageError message - |> Option.map(fun e -> Exception(sprintf "Error: %A" e)) - -let private awaitMessageReceival (client: IXmppClient) (lifetime: Lifetime) messageId = - // We need to perform this part synchronously to avoid the race condition between adding a message handler and - // actually sending a message. - let messageLifetimeDefinition = lifetime.CreateNested() - let messageLifetime = messageLifetimeDefinition.Lifetime - let messageReceivedTask = nestedTaskCompletionSource messageLifetime - client.AddMessageHandler lifetime (fun message -> - if hasMessageId messageId message then - match extractMessageException message with - | Some ex -> messageReceivedTask.SetException ex - | None -> messageReceivedTask.SetResult() - ) - async { - try - do! Async.AwaitTask messageReceivedTask.Task - finally - messageLifetimeDefinition.Dispose() - } - -/// Sends the message to the room. Returns an object that allows to track the message receival. -let sendRoomMessage (client: IXmppClient) (lifetime: Lifetime) (messageInfo: MessageInfo): Async = - async { - let messageId = Guid.NewGuid().ToString() // TODO[F]: Move to a new function - let message = SharpXmppHelper.message (Some messageId) messageInfo.RecipientJid.FullJid messageInfo.Text - let! delivery = Async.StartChild <| awaitMessageReceival client lifetime messageId - client.Send message - return { - MessageId = messageId - Delivery = delivery +type Wrapper(client: XmppClient) = + interface IXmppClient with + member ___.Connect() = async { + let! ct = Async.CancellationToken + return! Async.AwaitTask(client.ConnectAsync ct) } - } - -/// Waits for the message to be delivered. -let awaitMessageDelivery (deliveryInfo: MessageDeliveryInfo): Async = - deliveryInfo.Delivery + member __.JoinMultiUserChat roomJid nickname = SharpXmppHelper.joinRoom client roomJid.BareJid nickname + member __.Send message = client.Send message + member __.AddSignedInHandler lt handler = + let handlerDelegate = XmppClient.SignedInHandler(fun _ args -> handler args) + client.add_SignedIn handlerDelegate + lt.OnTermination(fun () -> client.remove_SignedIn handlerDelegate) |> ignore + member __.AddElementHandler lt handler = + let handlerDelegate = XmppClient.ElementHandler(fun _ args -> handler args) + client.add_Element handlerDelegate + lt.OnTermination(fun () -> client.remove_Element handlerDelegate) |> ignore + member __.AddConnectionFailedHandler lt handler = + let handlerDelegate = XmppClient.ConnectionFailedHandler(fun _ args -> handler args) + client.add_ConnectionFailed handlerDelegate + lt.OnTermination(fun () -> client.remove_ConnectionFailed handlerDelegate) |> ignore + member __.AddPresenceHandler lt handler = + let handlerDelegate = XmppClient.PresenceHandler(fun _ args -> handler args) + client.add_Presence handlerDelegate + lt.OnTermination(fun () -> client.remove_Presence handlerDelegate) |> ignore + member __.AddMessageHandler lt handler = + let handlerDelegate = XmppClient.MessageHandler(fun _ args -> handler args) + client.add_Message handlerDelegate + lt.OnTermination(fun () -> client.remove_Message handlerDelegate) |> ignore + +let create (settings: XmppSettings): XmppClient = + new XmppClient(JID(settings.Login), settings.Password) + +let wrap(client: XmppClient): IXmppClient = + upcast Wrapper client diff --git a/Emulsion/Xmpp/SharpXmppHelper.fs b/Emulsion/Xmpp/SharpXmppHelper.fs index 999a2e1e..00fd53ee 100644 --- a/Emulsion/Xmpp/SharpXmppHelper.fs +++ b/Emulsion/Xmpp/SharpXmppHelper.fs @@ -1,3 +1,4 @@ +/// Helper functions to deal with SharpXMPP low-level details (such as XML stuff). module Emulsion.Xmpp.SharpXmppHelper open System @@ -9,7 +10,7 @@ open SharpXMPP.XMPP.Client.MUC.Bookmarks.Elements open SharpXMPP.XMPP.Client.Elements open Emulsion -open Emulsion.Xmpp.XmppElements +open Emulsion.Xmpp module Namespaces = let MucUser = "http://jabber.org/protocol/muc#user" diff --git a/Emulsion/Xmpp/Types.fs b/Emulsion/Xmpp/Types.fs new file mode 100644 index 00000000..e213671e --- /dev/null +++ b/Emulsion/Xmpp/Types.fs @@ -0,0 +1,29 @@ +namespace Emulsion.Xmpp + +open System.Xml.Linq + +open SharpXMPP.XMPP + +type Presence = { + From: string + States: int[] + Error: XElement option + Type: string option +} + +type RoomInfo = { + RoomJid: JID + Nickname: string +} + +type MessageInfo = { + RecipientJid: JID + Text: string +} + +type MessageDeliveryInfo = { + MessageId: string + + /// Resolves after the message is guaranteed to be delivered to the recipient. + Delivery: Async +} diff --git a/Emulsion/Xmpp/XmppClient.fs b/Emulsion/Xmpp/XmppClient.fs index e375da36..4d3b6587 100644 --- a/Emulsion/Xmpp/XmppClient.fs +++ b/Emulsion/Xmpp/XmppClient.fs @@ -1,116 +1,135 @@ +/// A general abstraction around an XMPP client and common functions. module Emulsion.Xmpp.XmppClient open System -open System.Threading.Tasks open JetBrains.Lifetimes open Serilog + open SharpXMPP open SharpXMPP.XMPP +open SharpXMPP.XMPP.Client.Elements open Emulsion -open Emulsion.Settings -open SharpXMPP.XMPP.Client.Elements +open Emulsion.Lifetimes +open Emulsion.Xmpp type IXmppClient = abstract member Connect: unit -> Async abstract member JoinMultiUserChat: roomJid: JID -> nickname: string -> unit abstract member Send: XMPPMessage -> unit abstract member AddConnectionFailedHandler: Lifetime -> (ConnFailedArgs -> unit) -> unit + abstract member AddSignedInHandler: Lifetime -> (SignedInArgs -> unit) -> unit + abstract member AddElementHandler: Lifetime -> (ElementArgs -> unit) -> unit abstract member AddPresenceHandler: Lifetime -> (XMPPPresence -> unit) -> unit abstract member AddMessageHandler: Lifetime -> (XMPPMessage -> unit) -> unit -type SharpXmppClient(client: XmppClient) = - interface IXmppClient with - member ___.Connect() = async { - let! ct = Async.CancellationToken - return! Async.AwaitTask(client.ConnectAsync ct) - } - member __.JoinMultiUserChat roomJid nickname = SharpXmppHelper.joinRoom client roomJid.BareJid nickname - member __.Send message = client.Send message - member __.AddConnectionFailedHandler lt handler = - let handlerDelegate = XmppClient.ConnectionFailedHandler(fun _ args -> handler args) - client.add_ConnectionFailed handlerDelegate - lt.OnTermination(fun () -> client.remove_ConnectionFailed handlerDelegate) |> ignore - member __.AddPresenceHandler lt handler = - let handlerDelegate = XmppClient.PresenceHandler(fun _ args -> handler args) - client.add_Presence handlerDelegate - lt.OnTermination(fun () -> client.remove_Presence handlerDelegate) |> ignore - member __.AddMessageHandler lt handler = - let handlerDelegate = XmppClient.MessageHandler(fun _ args -> handler args) - client.add_Message handlerDelegate - lt.OnTermination(fun () -> client.remove_Message handlerDelegate) |> ignore - -// TODO[F]: This client should be removed -// TODO[F]: But preserve the logging routines; they're good -let private connectionFailedHandler (logger: ILogger) = XmppConnection.ConnectionFailedHandler(fun s e -> - logger.Error(e.Exception, "XMPP connection failed: {Message}", e.Message) - ()) - -let private signedInHandler (logger: ILogger) (settings: XmppSettings) (client: XmppClient) = - XmppConnection.SignedInHandler(fun s e -> - logger.Information("Connecting to {Room} as {Nickname}", settings.Room, settings.Nickname) - SharpXmppHelper.joinRoom client settings.Room settings.Nickname +/// Establish a connection to the server and log in. Returns a connection lifetime that will terminate if the connection +/// terminates. +let connect (logger: ILogger) (client: IXmppClient): Async = async { + let connectionLifetime = new LifetimeDefinition() + client.AddConnectionFailedHandler connectionLifetime.Lifetime <| fun error -> + connectionLifetime.Terminate() + + do! client.Connect() + return connectionLifetime.Lifetime +} + +let private isSelfPresence (roomInfo: RoomInfo) (presence: XMPPPresence) = + let presence = SharpXmppHelper.parsePresence presence + let expectedJid = sprintf "%s/%s" roomInfo.RoomJid.BareJid roomInfo.Nickname + presence.Type = None && presence.From = expectedJid && Array.contains 110 presence.States + +let private isLeavePresence (roomInfo: RoomInfo) (presence: XMPPPresence) = + let presence = SharpXmppHelper.parsePresence presence + let expectedJid = sprintf "%s/%s" roomInfo.RoomJid.BareJid roomInfo.Nickname + presence.From = expectedJid && Array.contains 110 presence.States && presence.Type = Some "unavailable" + +let private extractPresenceException (roomInfo: RoomInfo) (presence: XMPPPresence) = + let presence = SharpXmppHelper.parsePresence presence + let expectedJid = sprintf "%s/%s" roomInfo.RoomJid.BareJid roomInfo.Nickname + if presence.From = expectedJid then + presence.Error + |> Option.map (fun e -> Exception(sprintf "Error: %A" e)) + else None + +/// Enter the room, returning the in-room lifetime. Will terminate if kicked or left the room. +let enterRoom (client: IXmppClient) (lifetime: Lifetime) (roomInfo: RoomInfo): Async = async { + use connectionLifetimeDefinition = lifetime.CreateNested() + let connectionLifetime = connectionLifetimeDefinition.Lifetime + + let roomLifetimeDefinition = lifetime.CreateNested() + let roomLifetime = roomLifetimeDefinition.Lifetime + + let tcs = nestedTaskCompletionSource connectionLifetime + + // Success and error handlers: + client.AddPresenceHandler connectionLifetime (fun presence -> + if isSelfPresence roomInfo presence + then tcs.SetResult() + else + match extractPresenceException roomInfo presence with + | Some ex -> tcs.SetException ex + | None -> () ) -let private shouldProcessMessage settings message = - let isGroup = SharpXmppHelper.isGroupChatMessage message - let shouldSkip = lazy ( - SharpXmppHelper.isOwnMessage (settings.Nickname) message - || SharpXmppHelper.isHistoricalMessage message - || SharpXmppHelper.isEmptyMessage message + // Room leave handler: + client.AddPresenceHandler roomLifetime (fun presence -> + if isLeavePresence roomInfo presence + then roomLifetimeDefinition.Terminate() ) - isGroup && not shouldSkip.Value - -let private messageHandler (logger: ILogger) settings onMessage = XmppConnection.MessageHandler(fun _ element -> - logger.Verbose("Incoming XMPP message: {Message}", element) - if shouldProcessMessage settings element then - onMessage(XmppMessage (SharpXmppHelper.parseMessage element)) -) - -let private elementHandler (logger: ILogger) = XmppConnection.ElementHandler(fun s e -> - let direction = if e.IsInput then "incoming" else "outgoing" - logger.Verbose("XMPP stanza ({Direction}): {Stanza}", direction, e.Stanza) -) - -let private presenceHandler (logger: ILogger) = XmppConnection.PresenceHandler(fun s e -> - logger.Verbose("XMPP presence: {Presence}", e) -) - -let create (logger: ILogger) (settings: XmppSettings) (onMessage: IncomingMessage -> unit): XmppClient = - let client = new XmppClient(JID(settings.Login), settings.Password) - client.add_ConnectionFailed(connectionFailedHandler logger) - client.add_SignedIn(signedInHandler logger settings client) - client.add_Element(elementHandler logger) - client.add_Presence(presenceHandler logger) - client.add_Message(messageHandler logger settings onMessage) - client - -type ConnectionFailedError(message: string, innerException: Exception) = - inherit Exception(message, innerException) - -let run (logger: ILogger) (client: XmppClient): Async = - logger.Information("Running XMPP bot: {Jid}", client.Jid.FullJid) - let connectionFinished = TaskCompletionSource() - let connectionFailedHandler = - XmppConnection.ConnectionFailedHandler( - fun _ error -> connectionFinished.SetException(ConnectionFailedError(error.Message, error.Exception)) - ) + try + // Start the join process, wait for a result: + client.JoinMultiUserChat roomInfo.RoomJid roomInfo.Nickname + do! Async.AwaitTask tcs.Task + return roomLifetime + with + | ex -> + // In case of an error, terminate the room lifetime (but leave it intact in case of success): + roomLifetimeDefinition.Terminate() + return ExceptionUtils.reraise ex +} + +let private hasMessageId messageId message = + SharpXmppHelper.getMessageId message = Some messageId + +let private extractMessageException message = + SharpXmppHelper.getMessageError message + |> Option.map(fun e -> Exception(sprintf "Error: %A" e)) + +let private awaitMessageReceival (client: IXmppClient) (lifetime: Lifetime) messageId = + // We need to perform this part synchronously to avoid the race condition between adding a message handler and + // actually sending a message. + let messageLifetimeDefinition = lifetime.CreateNested() + let messageLifetime = messageLifetimeDefinition.Lifetime + let messageReceivedTask = nestedTaskCompletionSource messageLifetime + client.AddMessageHandler lifetime (fun message -> + if hasMessageId messageId message then + match extractMessageException message with + | Some ex -> messageReceivedTask.SetException ex + | None -> messageReceivedTask.SetResult() + ) async { try - let! token = Async.CancellationToken - use _ = token.Register(fun () -> client.Close()) - - client.add_ConnectionFailed connectionFailedHandler - do! Async.AwaitTask(client.ConnectAsync token) - - do! Async.AwaitTask connectionFinished.Task + do! Async.AwaitTask messageReceivedTask.Task finally - client.remove_ConnectionFailed connectionFailedHandler + messageLifetimeDefinition.Dispose() + } + +/// Sends the message to the room. Returns an object that allows to track the message receival. +let sendRoomMessage (client: IXmppClient) (lifetime: Lifetime) (messageInfo: MessageInfo): Async = + async { + let messageId = Guid.NewGuid().ToString() // TODO[F]: Move to a new function + let message = SharpXmppHelper.message (Some messageId) messageInfo.RecipientJid.FullJid messageInfo.Text + let! delivery = Async.StartChild <| awaitMessageReceival client lifetime messageId + client.Send message + return { + MessageId = messageId + Delivery = delivery + } } -let send (settings: XmppSettings) (client: XmppClient) (message: Message): unit = - let text = sprintf "<%s> %s" message.author message.text - SharpXmppHelper.message None settings.Room text - |> client.Send +/// Waits for the message to be delivered. +let awaitMessageDelivery (deliveryInfo: MessageDeliveryInfo): Async = + deliveryInfo.Delivery diff --git a/Emulsion/Xmpp/XmppElements.fs b/Emulsion/Xmpp/XmppElements.fs deleted file mode 100644 index 10b80980..00000000 --- a/Emulsion/Xmpp/XmppElements.fs +++ /dev/null @@ -1,10 +0,0 @@ -namespace Emulsion.Xmpp.XmppElements - -open System.Xml.Linq - -type Presence = { - From: string - States: int[] - Error: XElement option - Type: string option -} diff --git a/Emulsion/Xmpp/Client.fs b/Emulsion/Xmpp/XmppMessageSystem.fs similarity index 56% rename from Emulsion/Xmpp/Client.fs rename to Emulsion/Xmpp/XmppMessageSystem.fs index 4263a55e..ef30f6d1 100644 --- a/Emulsion/Xmpp/Client.fs +++ b/Emulsion/Xmpp/XmppMessageSystem.fs @@ -5,18 +5,19 @@ open System.Threading open Emulsion open Emulsion.MessageSystem open Emulsion.Settings +open Emulsion.Xmpp.XmppClient -// TODO[F]: Rename to an XmppMessageSystem? -type Client(ctx: ServiceContext, cancellationToken: CancellationToken, settings: XmppSettings) = +type XmppMessageSystem(ctx: ServiceContext, cancellationToken: CancellationToken, settings: XmppSettings) = inherit MessageSystemBase(ctx, cancellationToken) let client = ref None override __.RunUntilError receiver = async { - use newClient = XmppClient.create ctx.Logger settings receiver + use sharpXmpp = SharpXmppClient.create settings + let newClient = SharpXmppClient.wrap sharpXmpp |> EmulsionXmpp.initializeLogging ctx.Logger try Volatile.Write(client, Some newClient) - do! XmppClient.run ctx.Logger newClient + do! EmulsionXmpp.run settings ctx.Logger newClient receiver finally Volatile.Write(client, None) } @@ -25,5 +26,5 @@ type Client(ctx: ServiceContext, cancellationToken: CancellationToken, settings: match Volatile.Read(client) with | None -> failwith "Client is offline" | Some client -> - return XmppClient.send settings client message + return EmulsionXmpp.send settings client message } From 2857785bac128c998d09c001cc7eeadf70a9e719 Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sat, 7 Sep 2019 22:36:21 +0700 Subject: [PATCH 14/22] Wait for the message delivery before trying to send next message (#18) --- Emulsion/Xmpp/EmulsionXmpp.fs | 17 ++++++++++++----- Emulsion/Xmpp/XmppMessageSystem.fs | 10 ++++++---- 2 files changed, 18 insertions(+), 9 deletions(-) diff --git a/Emulsion/Xmpp/EmulsionXmpp.fs b/Emulsion/Xmpp/EmulsionXmpp.fs index da6e7712..3388b7dd 100644 --- a/Emulsion/Xmpp/EmulsionXmpp.fs +++ b/Emulsion/Xmpp/EmulsionXmpp.fs @@ -20,7 +20,7 @@ let private shouldProcessMessage (settings: XmppSettings) message = ) isGroup && not shouldSkip.Value -let private addMessageHandler settings lt (client: IXmppClient) receiver = +let private addMessageHandler (client: IXmppClient) lt settings receiver = client.AddMessageHandler lt (fun xmppMessage -> if shouldProcessMessage settings xmppMessage then let message = SharpXmppHelper.parseMessage xmppMessage @@ -46,7 +46,7 @@ let run (settings: XmppSettings) logger.Information "Connection succeeded" logger.Information "Initializing client handler" - addMessageHandler settings sessionLifetime client messageReceiver + addMessageHandler client sessionLifetime settings messageReceiver logger.Information "Client handler initialized" let roomInfo = { RoomJid = JID(settings.Room); Nickname = settings.Nickname } @@ -59,7 +59,14 @@ let run (settings: XmppSettings) logger.Information "Room lifetime has been terminated" } -let send (settings: XmppSettings) (client: IXmppClient) (message: Message): unit = +let send (logger: ILogger) + (client: IXmppClient) + (lifetime: Lifetime) + (settings: XmppSettings) + (message: Message): Async = async { let text = sprintf "<%s> %s" message.author message.text - SharpXmppHelper.message None settings.Room text - |> client.Send + let message = { RecipientJid = JID(settings.Room); Text = text } + let! deliveryInfo = XmppClient.sendRoomMessage client lifetime message + logger.Information("Message {MessageId} has been sent; awaiting delivery", deliveryInfo.MessageId) + do! XmppClient.awaitMessageDelivery deliveryInfo +} diff --git a/Emulsion/Xmpp/XmppMessageSystem.fs b/Emulsion/Xmpp/XmppMessageSystem.fs index ef30f6d1..2e0e1569 100644 --- a/Emulsion/Xmpp/XmppMessageSystem.fs +++ b/Emulsion/Xmpp/XmppMessageSystem.fs @@ -2,10 +2,11 @@ namespace Emulsion.Xmpp open System.Threading +open JetBrains.Lifetimes + open Emulsion open Emulsion.MessageSystem open Emulsion.Settings -open Emulsion.Xmpp.XmppClient type XmppMessageSystem(ctx: ServiceContext, cancellationToken: CancellationToken, settings: XmppSettings) = inherit MessageSystemBase(ctx, cancellationToken) @@ -15,8 +16,9 @@ type XmppMessageSystem(ctx: ServiceContext, cancellationToken: CancellationToken override __.RunUntilError receiver = async { use sharpXmpp = SharpXmppClient.create settings let newClient = SharpXmppClient.wrap sharpXmpp |> EmulsionXmpp.initializeLogging ctx.Logger + use newClientLifetimeDef = Lifetime.Define() try - Volatile.Write(client, Some newClient) + Volatile.Write(client, Some (newClient, newClientLifetimeDef.Lifetime)) do! EmulsionXmpp.run settings ctx.Logger newClient receiver finally Volatile.Write(client, None) @@ -25,6 +27,6 @@ type XmppMessageSystem(ctx: ServiceContext, cancellationToken: CancellationToken override __.Send (OutgoingMessage message) = async { match Volatile.Read(client) with | None -> failwith "Client is offline" - | Some client -> - return EmulsionXmpp.send settings client message + | Some (client, lt) -> + return! EmulsionXmpp.send ctx.Logger client lt settings message } From 651247919c398c8f2ae888d6e00ac026cbb9d9eb Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sun, 8 Sep 2019 18:49:51 +0700 Subject: [PATCH 15/22] Add test for ExceptionUtils (#18) --- Emulsion.Tests/Emulsion.Tests.fsproj | 1 + Emulsion.Tests/ExceptionUtilsTests.fs | 35 +++++++++++++++++++++++++++ 2 files changed, 36 insertions(+) create mode 100644 Emulsion.Tests/ExceptionUtilsTests.fs diff --git a/Emulsion.Tests/Emulsion.Tests.fsproj b/Emulsion.Tests/Emulsion.Tests.fsproj index 8896644f..c58cc9db 100644 --- a/Emulsion.Tests/Emulsion.Tests.fsproj +++ b/Emulsion.Tests/Emulsion.Tests.fsproj @@ -7,6 +7,7 @@ + diff --git a/Emulsion.Tests/ExceptionUtilsTests.fs b/Emulsion.Tests/ExceptionUtilsTests.fs new file mode 100644 index 00000000..1bf8a38b --- /dev/null +++ b/Emulsion.Tests/ExceptionUtilsTests.fs @@ -0,0 +1,35 @@ +module Emulsion.Tests.ExceptionUtilsTests + +open System + +open Emulsion +open Xunit + +[] +let ``reraise works in sync code``(): unit = + let nestedStacktrace() = + raise <| Exception("Foo") + let thrown = + try + nestedStacktrace() + null + with + | ex -> ex + let rethrown = Assert.Throws(fun () -> ExceptionUtils.reraise thrown |> ignore) + Assert.Contains("nestedStacktrace", rethrown.StackTrace) + +[] +let ``reraise works in async code``(): unit = + let nestedStacktrace() = + raise <| Exception("Foo") + + let ex = Assert.Throws(fun () -> + async { + try + nestedStacktrace() + with + | ex -> + ExceptionUtils.reraise ex + } |> Async.RunSynchronously + ) + Assert.Contains("nestedStacktrace", ex.StackTrace) From 85c2f7ccbf1e73de086466440779c45f0b3b8638 Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sun, 8 Sep 2019 19:38:58 +0700 Subject: [PATCH 16/22] Add tests for the Lifetimes module (#18) --- Emulsion.Tests/Emulsion.Tests.fsproj | 3 ++- Emulsion.Tests/LifetimesTests.fs | 25 +++++++++++++++++++++++++ 2 files changed, 27 insertions(+), 1 deletion(-) create mode 100644 Emulsion.Tests/LifetimesTests.fs diff --git a/Emulsion.Tests/Emulsion.Tests.fsproj b/Emulsion.Tests/Emulsion.Tests.fsproj index c58cc9db..3491ce81 100644 --- a/Emulsion.Tests/Emulsion.Tests.fsproj +++ b/Emulsion.Tests/Emulsion.Tests.fsproj @@ -8,8 +8,9 @@ - + + diff --git a/Emulsion.Tests/LifetimesTests.fs b/Emulsion.Tests/LifetimesTests.fs new file mode 100644 index 00000000..5962273c --- /dev/null +++ b/Emulsion.Tests/LifetimesTests.fs @@ -0,0 +1,25 @@ +module Emulsion.Tests.LifetimesTests + +open JetBrains.Lifetimes + +open Xunit + +open System.Threading.Tasks +open Emulsion.Lifetimes + +[] +let ``nestedTaskCompletionSource getting cancelled after parent lifetime termination``(): unit = + use ld = Lifetime.Define() + let tcs = nestedTaskCompletionSource ld.Lifetime + let task = tcs.Task + Assert.False task.IsCompleted + ld.Terminate() + Assert.Throws(fun () -> task.GetAwaiter().GetResult() |> ignore) |> ignore + +[] +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 From 98d75bc0a7200de2fd7f80c0d94d88c65eb0fd7c Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sun, 8 Sep 2019 20:46:36 +0700 Subject: [PATCH 17/22] Add tests for EmulsionXmpp (#18) --- Emulsion.Tests/Emulsion.Tests.fsproj | 5 +- .../{Settings.fs => SettingsTests.fs} | 2 +- Emulsion.Tests/Xmpp/EmulsionXmppTests.fs | 170 ++++++++ ...pXmppHelper.fs => SharpXmppHelperTests.fs} | 2 +- Emulsion.Tests/Xmpp/XmppClientTests.fs | 405 +++++++++--------- Emulsion/Xmpp/EmulsionXmpp.fs | 4 +- Emulsion/Xmpp/SharpXmppHelper.fs | 2 +- Emulsion/Xmpp/XmppClient.fs | 4 +- 8 files changed, 380 insertions(+), 214 deletions(-) rename Emulsion.Tests/{Settings.fs => SettingsTests.fs} (96%) create mode 100644 Emulsion.Tests/Xmpp/EmulsionXmppTests.fs rename Emulsion.Tests/Xmpp/{SharpXmppHelper.fs => SharpXmppHelperTests.fs} (98%) diff --git a/Emulsion.Tests/Emulsion.Tests.fsproj b/Emulsion.Tests/Emulsion.Tests.fsproj index 3491ce81..2300bc39 100644 --- a/Emulsion.Tests/Emulsion.Tests.fsproj +++ b/Emulsion.Tests/Emulsion.Tests.fsproj @@ -10,7 +10,7 @@ - + @@ -20,8 +20,9 @@ - + + diff --git a/Emulsion.Tests/Settings.fs b/Emulsion.Tests/SettingsTests.fs similarity index 96% rename from Emulsion.Tests/Settings.fs rename to Emulsion.Tests/SettingsTests.fs index 2045bc31..596c1b80 100644 --- a/Emulsion.Tests/Settings.fs +++ b/Emulsion.Tests/SettingsTests.fs @@ -1,4 +1,4 @@ -module Emulsion.Tests.Settings +module Emulsion.Tests.SettingsTests open System open System.IO diff --git a/Emulsion.Tests/Xmpp/EmulsionXmppTests.fs b/Emulsion.Tests/Xmpp/EmulsionXmppTests.fs new file mode 100644 index 00000000..ac263001 --- /dev/null +++ b/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 + + [] + 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(fun() -> Async.RunSynchronously <| EmulsionXmpp.run settings logger client ignore) + |> ignore + Assert.True connectCalled + + [] + 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(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(fun() -> + Async.RunSynchronously <| EmulsionXmpp.run settings logger client onMessageReceived + ) |> ignore + + messageReceived + + [] + 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) + + [] + 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) + + [] + 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) + + [] + 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 + + [] + 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(fun () -> + Async.RunSynchronously <| EmulsionXmpp.send logger client lt settings outgoingMessage + ) |> ignore + + let text = sentMessage.Element(Body).Value + Assert.Equal(" text", text) + + [] + member __.``send function awaits the message delivery``(): Task = + upcast (async { + use ld = Lifetime.Define() + let lt = ld.Lifetime + let messageId = nestedTaskCompletionSource lt + 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(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) diff --git a/Emulsion.Tests/Xmpp/SharpXmppHelper.fs b/Emulsion.Tests/Xmpp/SharpXmppHelperTests.fs similarity index 98% rename from Emulsion.Tests/Xmpp/SharpXmppHelper.fs rename to Emulsion.Tests/Xmpp/SharpXmppHelperTests.fs index a7cb773a..68e6189e 100644 --- a/Emulsion.Tests/Xmpp/SharpXmppHelper.fs +++ b/Emulsion.Tests/Xmpp/SharpXmppHelperTests.fs @@ -1,4 +1,4 @@ -module Emulsion.Tests.Xmpp.SharpXmppHelper +module Emulsion.Tests.Xmpp.SharpXmppHelperTests open System.Xml.Linq diff --git a/Emulsion.Tests/Xmpp/XmppClientTests.fs b/Emulsion.Tests/Xmpp/XmppClientTests.fs index eb14865d..9f267dd6 100644 --- a/Emulsion.Tests/Xmpp/XmppClientTests.fs +++ b/Emulsion.Tests/Xmpp/XmppClientTests.fs @@ -1,4 +1,4 @@ -namespace Emulsion.Tests.Xmpp +module Emulsion.Tests.Xmpp.XmppClientTests open System open System.Threading.Tasks @@ -9,223 +9,218 @@ open SharpXMPP open SharpXMPP.XMPP open SharpXMPP.XMPP.Client.Elements open Xunit -open Xunit.Abstractions -open Emulsion.Tests.TestUtils open Emulsion.Xmpp open Emulsion.Xmpp.SharpXmppHelper.Attributes open Emulsion.Xmpp.SharpXmppHelper.Elements -type XmppClientTests(testOutput: ITestOutputHelper) = - let logger = Logging.xunitLogger testOutput - - let createPresenceFor (roomJid: JID) nickname = - let presence = XMPPPresence() - let participantJid = JID(roomJid.FullJid) - participantJid.Resource <- nickname - presence.SetAttributeValue(From, participantJid.FullJid) - presence - - let createSelfPresence roomJid nickname = - let presence = createPresenceFor roomJid nickname - let x = XElement X - let status = XElement Status - status.SetAttributeValue(Code, "110") - x.Add status - presence.Add x - presence - - let createErrorPresence roomJid nickname errorXml = - let presence = createPresenceFor roomJid nickname - presence.SetAttributeValue(Type, "error") - let error = XElement Error - let errorChild = XElement.Parse errorXml - error.Add errorChild - presence.Add error - presence - - let createLeavePresence roomJid nickname = - let presence = createSelfPresence roomJid nickname - presence.SetAttributeValue(Type, "unavailable") - presence - - let sendPresence presence handlers = - Seq.iter (fun h -> h presence) handlers - - let createErrorMessage (message: XMPPMessage) errorXml = - // An error message is an exact copy of the original with the "error" element added: - let errorMessage = XMPPMessage() - message.Attributes() |> Seq.iter (fun a -> errorMessage.SetAttributeValue(a.Name, a.Value)) - message.Elements() |> Seq.iter (fun e -> errorMessage.Add e) - - let error = XElement Error - let errorChild = XElement.Parse errorXml - error.Add errorChild - errorMessage.Add error - errorMessage - - [] - member __.``connect function calls the Connect method of the client passed``(): unit = - let mutable connectCalled = false - let client = XmppClientFactory.create(fun () -> async { connectCalled <- true }) - Async.RunSynchronously <| XmppClient.connect logger client |> ignore - Assert.True connectCalled - - [] - member __.``connect function returns a lifetime terminated whenever the ConnectionFailed callback is triggered``() - : unit = - let mutable callback = ignore - let client = XmppClientFactory.create(addConnectionFailedHandler = fun _ h -> callback <- h) - let lt = Async.RunSynchronously <| XmppClient.connect logger client - Assert.True lt.IsAlive - callback(ConnFailedArgs()) - Assert.False lt.IsAlive - - [] - member __.``enter function calls JoinMultiUserChat``(): unit = - let mutable called = false - let mutable presenceHandlers = ResizeArray() - let client = - XmppClientFactory.create( - addPresenceHandler = (fun _ h -> presenceHandlers.Add h), - joinMultiUserChat = fun roomJid nickname -> - called <- true - Seq.iter (fun h -> h (createSelfPresence roomJid nickname)) presenceHandlers - ) - let roomInfo = { RoomJid = JID("room@conference.example.org"); Nickname = "testuser" } - Lifetime.Using(fun lt -> - Async.RunSynchronously <| XmppClient.enterRoom client lt roomInfo |> ignore - Assert.True called +let private createPresenceFor (roomJid: JID) nickname = + let presence = XMPPPresence() + let participantJid = JID(roomJid.FullJid) + participantJid.Resource <- nickname + presence.SetAttributeValue(From, participantJid.FullJid) + presence + +let private createSelfPresence roomJid nickname = + let presence = createPresenceFor roomJid nickname + let x = XElement X + let status = XElement Status + status.SetAttributeValue(Code, "110") + x.Add status + presence.Add x + presence + +let private createErrorPresence roomJid nickname errorXml = + let presence = createPresenceFor roomJid nickname + presence.SetAttributeValue(Type, "error") + let error = XElement Error + let errorChild = XElement.Parse errorXml + error.Add errorChild + presence.Add error + presence + +let private createLeavePresence roomJid nickname = + let presence = createSelfPresence roomJid nickname + presence.SetAttributeValue(Type, "unavailable") + presence + +let private sendPresence presence handlers = + Seq.iter (fun h -> h presence) handlers + +let private createErrorMessage (message: XMPPMessage) errorXml = + // An error message is an exact copy of the original with the "error" element added: + let errorMessage = XMPPMessage() + message.Attributes() |> Seq.iter (fun a -> errorMessage.SetAttributeValue(a.Name, a.Value)) + message.Elements() |> Seq.iter (fun e -> errorMessage.Add e) + + let error = XElement Error + let errorChild = XElement.Parse errorXml + error.Add errorChild + errorMessage.Add error + errorMessage + +[] +let ``connect function calls the Connect method of the client passed``(): unit = + let mutable connectCalled = false + let client = XmppClientFactory.create(fun () -> async { connectCalled <- true }) + Async.RunSynchronously <| XmppClient.connect client |> ignore + Assert.True connectCalled + +[] +let ``connect function returns a lifetime terminated whenever the ConnectionFailed callback is triggered``() + : unit = + let mutable callback = ignore + let client = XmppClientFactory.create(addConnectionFailedHandler = fun _ h -> callback <- h) + let lt = Async.RunSynchronously <| XmppClient.connect client + Assert.True lt.IsAlive + callback(ConnFailedArgs()) + Assert.False lt.IsAlive + +[] +let ``enter function calls JoinMultiUserChat``(): unit = + let mutable called = false + let mutable presenceHandlers = ResizeArray() + let client = + XmppClientFactory.create( + addPresenceHandler = (fun _ h -> presenceHandlers.Add h), + joinMultiUserChat = fun roomJid nickname -> + called <- true + Seq.iter (fun h -> h (createSelfPresence roomJid nickname)) presenceHandlers ) - - [] - member __.``enter throws an exception in case of an error presence``(): unit = - let mutable presenceHandlers = ResizeArray() - let client = - XmppClientFactory.create( - addPresenceHandler = (fun _ h -> presenceHandlers.Add h), - joinMultiUserChat = fun roomJid nickname -> - sendPresence (createErrorPresence roomJid nickname "") presenceHandlers - ) - let roomInfo = { RoomJid = JID("room@conference.example.org"); Nickname = "testuser" } - Lifetime.Using(fun lt -> - let ae = Assert.Throws(fun () -> - Async.RunSynchronously <| XmppClient.enterRoom client lt roomInfo |> ignore - ) - let ex = Seq.exactlyOne ae.InnerExceptions - Assert.Contains("", ex.Message) + let roomInfo = { RoomJid = JID("room@conference.example.org"); Nickname = "testuser" } + Lifetime.Using(fun lt -> + Async.RunSynchronously <| XmppClient.enterRoom client lt roomInfo |> ignore + Assert.True called + ) + +[] +let ``enter throws an exception in case of an error presence``(): unit = + let mutable presenceHandlers = ResizeArray() + let client = + XmppClientFactory.create( + addPresenceHandler = (fun _ h -> presenceHandlers.Add h), + joinMultiUserChat = fun roomJid nickname -> + sendPresence (createErrorPresence roomJid nickname "") presenceHandlers ) - - [] - member __.``Lifetime returned from enter terminates by a room leave presence``(): unit = - let mutable presenceHandlers = ResizeArray() - let client = - XmppClientFactory.create( - addPresenceHandler = (fun _ h -> presenceHandlers.Add h), - joinMultiUserChat = fun roomJid nickname -> - sendPresence (createSelfPresence roomJid nickname) presenceHandlers - ) - let roomInfo = { RoomJid = JID("room@conference.example.org"); Nickname = "testuser" } - Lifetime.Using(fun lt -> - let roomLt = Async.RunSynchronously <| XmppClient.enterRoom client lt roomInfo - Assert.True roomLt.IsAlive - sendPresence (createLeavePresence roomInfo.RoomJid roomInfo.Nickname) presenceHandlers - Assert.False roomLt.IsAlive + let roomInfo = { RoomJid = JID("room@conference.example.org"); Nickname = "testuser" } + Lifetime.Using(fun lt -> + let ae = Assert.Throws(fun () -> + Async.RunSynchronously <| XmppClient.enterRoom client lt roomInfo |> ignore ) - - [] - member __.``Lifetime returned from enter terminates by an external lifetime termination``(): unit = - let mutable presenceHandlers = ResizeArray() - let client = - XmppClientFactory.create( - addPresenceHandler = (fun _ h -> presenceHandlers.Add h), - joinMultiUserChat = fun roomJid nickname -> - sendPresence (createSelfPresence roomJid nickname) presenceHandlers - ) - let roomInfo = { RoomJid = JID("room@conference.example.org"); Nickname = "testuser" } - use ld = Lifetime.Define() - let lt = ld.Lifetime + let ex = Seq.exactlyOne ae.InnerExceptions + Assert.Contains("", ex.Message) + ) + +[] +let ``Lifetime returned from enter terminates by a room leave presence``(): unit = + let mutable presenceHandlers = ResizeArray() + let client = + XmppClientFactory.create( + addPresenceHandler = (fun _ h -> presenceHandlers.Add h), + joinMultiUserChat = fun roomJid nickname -> + sendPresence (createSelfPresence roomJid nickname) presenceHandlers + ) + let roomInfo = { RoomJid = JID("room@conference.example.org"); Nickname = "testuser" } + Lifetime.Using(fun lt -> let roomLt = Async.RunSynchronously <| XmppClient.enterRoom client lt roomInfo Assert.True roomLt.IsAlive - ld.Terminate() + sendPresence (createLeavePresence roomInfo.RoomJid roomInfo.Nickname) presenceHandlers Assert.False roomLt.IsAlive - - [] - member __.``sendRoomMessage calls Send method on the client``(): unit = - let mutable message = Unchecked.defaultof - let client = XmppClientFactory.create(send = fun m -> message <- m) - let messageInfo = { RecipientJid = JID("room@conference.example.org"); Text = "foo bar" } - Lifetime.Using(fun lt -> - Async.RunSynchronously <| XmppClient.sendRoomMessage client lt messageInfo |> ignore - Assert.Equal(messageInfo.RecipientJid.FullJid, message.To.FullJid) - Assert.Equal(messageInfo.Text, message.Text) - ) - - [] - member __.``sendRoomMessage's result gets resolved after the message receival``(): unit = - let mutable messageHandler = ignore - let mutable message = Unchecked.defaultof - let client = - XmppClientFactory.create( - addMessageHandler = (fun _ h -> messageHandler <- h), - send = fun m -> message <- m - ) - let messageInfo = { RecipientJid = JID("room@conference.example.org"); Text = "foo bar" } - Lifetime.Using(fun lt -> - let deliveryInfo = Async.RunSynchronously <| XmppClient.sendRoomMessage client lt messageInfo - Assert.Equal(message.ID, deliveryInfo.MessageId) - let deliveryTask = Async.StartAsTask deliveryInfo.Delivery - Assert.False deliveryTask.IsCompleted - messageHandler message - deliveryTask.Wait() - ) - - [] - member __.``sendRoomMessage's result doesn't get resolved after receiving other message``(): unit = - let mutable messageHandler = ignore - let client = XmppClientFactory.create(addMessageHandler = fun _ h -> messageHandler <- h) - let messageInfo = { RecipientJid = JID("room@conference.example.org"); Text = "foo bar" } - Lifetime.Using(fun lt -> - let deliveryInfo = Async.RunSynchronously <| XmppClient.sendRoomMessage client lt messageInfo - let deliveryTask = Async.StartAsTask deliveryInfo.Delivery - Assert.False deliveryTask.IsCompleted - - let otherMessage = SharpXmppHelper.message (Some "xxx") "nickname@example.org" "foo bar" - messageHandler otherMessage - Assert.False deliveryTask.IsCompleted + ) + +[] +let ``Lifetime returned from enter terminates by an external lifetime termination``(): unit = + let mutable presenceHandlers = ResizeArray() + let client = + XmppClientFactory.create( + addPresenceHandler = (fun _ h -> presenceHandlers.Add h), + joinMultiUserChat = fun roomJid nickname -> + sendPresence (createSelfPresence roomJid nickname) presenceHandlers ) - - [] - member __.``sendRoomMessage's result gets resolved with an error if an error response is received``(): unit = - let mutable messageHandler = ignore - let client = - XmppClientFactory.create( - addMessageHandler = (fun _ h -> messageHandler <- h), - send = fun m -> messageHandler(createErrorMessage m "") - ) - let messageInfo = { RecipientJid = JID("room@conference.example.org"); Text = "foo bar" } - Lifetime.Using(fun lt -> - let deliveryInfo = Async.RunSynchronously <| XmppClient.sendRoomMessage client lt messageInfo - let ae = Assert.Throws(fun () -> Async.RunSynchronously deliveryInfo.Delivery) - let ex = Seq.exactlyOne ae.InnerExceptions - Assert.Contains("", ex.Message) + let roomInfo = { RoomJid = JID("room@conference.example.org"); Nickname = "testuser" } + use ld = Lifetime.Define() + let lt = ld.Lifetime + let roomLt = Async.RunSynchronously <| XmppClient.enterRoom client lt roomInfo + Assert.True roomLt.IsAlive + ld.Terminate() + Assert.False roomLt.IsAlive + +[] +let ``sendRoomMessage calls Send method on the client``(): unit = + let mutable message = Unchecked.defaultof + let client = XmppClientFactory.create(send = fun m -> message <- m) + let messageInfo = { RecipientJid = JID("room@conference.example.org"); Text = "foo bar" } + Lifetime.Using(fun lt -> + Async.RunSynchronously <| XmppClient.sendRoomMessage client lt messageInfo |> ignore + Assert.Equal(messageInfo.RecipientJid.FullJid, message.To.FullJid) + Assert.Equal(messageInfo.Text, message.Text) + ) + +[] +let ``sendRoomMessage's result gets resolved after the message receival``(): unit = + let mutable messageHandler = ignore + let mutable message = Unchecked.defaultof + let client = + XmppClientFactory.create( + addMessageHandler = (fun _ h -> messageHandler <- h), + send = fun m -> message <- m ) - - [] - member __.``sendRoomMessage's result gets terminated after parent lifetime termination``(): unit = - let client = XmppClientFactory.create() - let messageInfo = { RecipientJid = JID("room@conference.example.org"); Text = "foo bar" } - use ld = Lifetime.Define() - let lt = ld.Lifetime + let messageInfo = { RecipientJid = JID("room@conference.example.org"); Text = "foo bar" } + Lifetime.Using(fun lt -> + let deliveryInfo = Async.RunSynchronously <| XmppClient.sendRoomMessage client lt messageInfo + Assert.Equal(message.ID, deliveryInfo.MessageId) + let deliveryTask = Async.StartAsTask deliveryInfo.Delivery + Assert.False deliveryTask.IsCompleted + messageHandler message + deliveryTask.Wait() + ) + +[] +let ``sendRoomMessage's result doesn't get resolved after receiving other message``(): unit = + let mutable messageHandler = ignore + let client = XmppClientFactory.create(addMessageHandler = fun _ h -> messageHandler <- h) + let messageInfo = { RecipientJid = JID("room@conference.example.org"); Text = "foo bar" } + Lifetime.Using(fun lt -> let deliveryInfo = Async.RunSynchronously <| XmppClient.sendRoomMessage client lt messageInfo let deliveryTask = Async.StartAsTask deliveryInfo.Delivery Assert.False deliveryTask.IsCompleted - ld.Terminate() - Assert.Throws(fun () -> deliveryTask.GetAwaiter().GetResult()) |> ignore - - [] - member __.``awaitMessageDelivery just returns an async from the delivery info``(): unit = - let async = async { return () } - let deliveryInfo = { MessageId = ""; Delivery = async } - let result = XmppClient.awaitMessageDelivery deliveryInfo - Assert.True(Object.ReferenceEquals(async, result)) + + let otherMessage = SharpXmppHelper.message (Some "xxx") "nickname@example.org" "foo bar" + messageHandler otherMessage + Assert.False deliveryTask.IsCompleted + ) + +[] +let ``sendRoomMessage's result gets resolved with an error if an error response is received``(): unit = + let mutable messageHandler = ignore + let client = + XmppClientFactory.create( + addMessageHandler = (fun _ h -> messageHandler <- h), + send = fun m -> messageHandler(createErrorMessage m "") + ) + let messageInfo = { RecipientJid = JID("room@conference.example.org"); Text = "foo bar" } + Lifetime.Using(fun lt -> + let deliveryInfo = Async.RunSynchronously <| XmppClient.sendRoomMessage client lt messageInfo + let ae = Assert.Throws(fun () -> Async.RunSynchronously deliveryInfo.Delivery) + let ex = Seq.exactlyOne ae.InnerExceptions + Assert.Contains("", ex.Message) + ) + +[] +let ``sendRoomMessage's result gets terminated after parent lifetime termination``(): unit = + let client = XmppClientFactory.create() + let messageInfo = { RecipientJid = JID("room@conference.example.org"); Text = "foo bar" } + use ld = Lifetime.Define() + let lt = ld.Lifetime + let deliveryInfo = Async.RunSynchronously <| XmppClient.sendRoomMessage client lt messageInfo + let deliveryTask = Async.StartAsTask deliveryInfo.Delivery + Assert.False deliveryTask.IsCompleted + ld.Terminate() + Assert.Throws(fun () -> deliveryTask.GetAwaiter().GetResult()) |> ignore + +[] +let ``awaitMessageDelivery just returns an async from the delivery info``(): unit = + let async = async { return () } + let deliveryInfo = { MessageId = ""; Delivery = async } + let result = XmppClient.awaitMessageDelivery deliveryInfo + Assert.True(Object.ReferenceEquals(async, result)) diff --git a/Emulsion/Xmpp/EmulsionXmpp.fs b/Emulsion/Xmpp/EmulsionXmpp.fs index 3388b7dd..c198d8cd 100644 --- a/Emulsion/Xmpp/EmulsionXmpp.fs +++ b/Emulsion/Xmpp/EmulsionXmpp.fs @@ -1,5 +1,4 @@ /// Main business logic for an XMPP part of the Emulsion application. -/// TODO[F]: Add tests for this module. module Emulsion.Xmpp.EmulsionXmpp open JetBrains.Lifetimes @@ -42,7 +41,8 @@ let run (settings: XmppSettings) (client: IXmppClient) (messageReceiver: IncomingMessageReceiver): Async = async { logger.Information "Connecting to the server" - let! sessionLifetime = XmppClient.connect logger client + let! sessionLifetime = XmppClient.connect client + sessionLifetime.ThrowIfNotAlive() logger.Information "Connection succeeded" logger.Information "Initializing client handler" diff --git a/Emulsion/Xmpp/SharpXmppHelper.fs b/Emulsion/Xmpp/SharpXmppHelper.fs index 00fd53ee..450fe82c 100644 --- a/Emulsion/Xmpp/SharpXmppHelper.fs +++ b/Emulsion/Xmpp/SharpXmppHelper.fs @@ -105,7 +105,7 @@ let parsePresence(presence: XMPPPresence): Presence = presence.Element X |> Option.ofObj |> Option.map (fun x -> - x.Elements(Status) + x.Elements Status |> Seq.choose (fun s -> getAttributeValue s Code) |> Seq.map int ) diff --git a/Emulsion/Xmpp/XmppClient.fs b/Emulsion/Xmpp/XmppClient.fs index 4d3b6587..65b547a1 100644 --- a/Emulsion/Xmpp/XmppClient.fs +++ b/Emulsion/Xmpp/XmppClient.fs @@ -26,9 +26,9 @@ type IXmppClient = /// Establish a connection to the server and log in. Returns a connection lifetime that will terminate if the connection /// terminates. -let connect (logger: ILogger) (client: IXmppClient): Async = async { +let connect (client: IXmppClient): Async = async { let connectionLifetime = new LifetimeDefinition() - client.AddConnectionFailedHandler connectionLifetime.Lifetime <| fun error -> + client.AddConnectionFailedHandler connectionLifetime.Lifetime <| fun _ -> connectionLifetime.Terminate() do! client.Connect() From 306dbbaca86f366dff33ad161da2d346e2e05a85 Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sun, 8 Sep 2019 20:51:16 +0700 Subject: [PATCH 18/22] Small formatting fixes around XmppClient (#18) --- Emulsion.Tests/Xmpp/XmppClientTests.fs | 11 +++++------ Emulsion/Xmpp/XmppClient.fs | 1 - 2 files changed, 5 insertions(+), 7 deletions(-) diff --git a/Emulsion.Tests/Xmpp/XmppClientTests.fs b/Emulsion.Tests/Xmpp/XmppClientTests.fs index 9f267dd6..d9147160 100644 --- a/Emulsion.Tests/Xmpp/XmppClientTests.fs +++ b/Emulsion.Tests/Xmpp/XmppClientTests.fs @@ -67,8 +67,7 @@ let ``connect function calls the Connect method of the client passed``(): unit = Assert.True connectCalled [] -let ``connect function returns a lifetime terminated whenever the ConnectionFailed callback is triggered``() - : unit = +let ``connect function returns a lifetime terminated whenever the ConnectionFailed callback is triggered``(): unit = let mutable callback = ignore let client = XmppClientFactory.create(addConnectionFailedHandler = fun _ h -> callback <- h) let lt = Async.RunSynchronously <| XmppClient.connect client @@ -77,7 +76,7 @@ let ``connect function returns a lifetime terminated whenever the ConnectionFail Assert.False lt.IsAlive [] -let ``enter function calls JoinMultiUserChat``(): unit = +let ``enterRoom function calls JoinMultiUserChat``(): unit = let mutable called = false let mutable presenceHandlers = ResizeArray() let client = @@ -94,7 +93,7 @@ let ``enter function calls JoinMultiUserChat``(): unit = ) [] -let ``enter throws an exception in case of an error presence``(): unit = +let ``enterRoom throws an exception in case of an error presence``(): unit = let mutable presenceHandlers = ResizeArray() let client = XmppClientFactory.create( @@ -112,7 +111,7 @@ let ``enter throws an exception in case of an error presence``(): unit = ) [] -let ``Lifetime returned from enter terminates by a room leave presence``(): unit = +let ``Lifetime returned from enterRoom terminates by a room leave presence``(): unit = let mutable presenceHandlers = ResizeArray() let client = XmppClientFactory.create( @@ -129,7 +128,7 @@ let ``Lifetime returned from enter terminates by a room leave presence``(): unit ) [] -let ``Lifetime returned from enter terminates by an external lifetime termination``(): unit = +let ``Lifetime returned from enterRoom terminates by an external lifetime termination``(): unit = let mutable presenceHandlers = ResizeArray() let client = XmppClientFactory.create( diff --git a/Emulsion/Xmpp/XmppClient.fs b/Emulsion/Xmpp/XmppClient.fs index 65b547a1..eedb3a80 100644 --- a/Emulsion/Xmpp/XmppClient.fs +++ b/Emulsion/Xmpp/XmppClient.fs @@ -4,7 +4,6 @@ module Emulsion.Xmpp.XmppClient open System open JetBrains.Lifetimes -open Serilog open SharpXMPP open SharpXMPP.XMPP From f4f2ad7ddef0dedc16db2497da870fa6354b9596 Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sun, 8 Sep 2019 20:57:56 +0700 Subject: [PATCH 19/22] Make messageId a required parameter for SharpXmppHelper.message (#18) --- Emulsion.Tests/Xmpp/EmulsionXmppTests.fs | 2 +- Emulsion.Tests/Xmpp/SharpXmppHelperTests.fs | 2 +- Emulsion.Tests/Xmpp/XmppClientTests.fs | 2 +- Emulsion/Xmpp/SharpXmppHelper.fs | 5 ++--- Emulsion/Xmpp/XmppClient.fs | 7 +++++-- 5 files changed, 10 insertions(+), 8 deletions(-) diff --git a/Emulsion.Tests/Xmpp/EmulsionXmppTests.fs b/Emulsion.Tests/Xmpp/EmulsionXmppTests.fs index ac263001..ae798154 100644 --- a/Emulsion.Tests/Xmpp/EmulsionXmppTests.fs +++ b/Emulsion.Tests/Xmpp/EmulsionXmppTests.fs @@ -153,7 +153,7 @@ type SendTests(outputHelper: ITestOutputHelper) = let client = XmppClientFactory.create( addMessageHandler = (fun _ h -> messageHandlers.Add h), - send = fun m -> messageId.SetResult(SharpXmppHelper.getMessageId m) + send = fun m -> messageId.SetResult(Option.get <| SharpXmppHelper.getMessageId m) ) let outgoingMessage = { author = "author"; text = "text" } diff --git a/Emulsion.Tests/Xmpp/SharpXmppHelperTests.fs b/Emulsion.Tests/Xmpp/SharpXmppHelperTests.fs index 68e6189e..75fcf1ef 100644 --- a/Emulsion.Tests/Xmpp/SharpXmppHelperTests.fs +++ b/Emulsion.Tests/Xmpp/SharpXmppHelperTests.fs @@ -10,7 +10,7 @@ open Emulsion.Xmpp [] let ``Message body has a proper namespace``() = - let message = SharpXmppHelper.message None "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) diff --git a/Emulsion.Tests/Xmpp/XmppClientTests.fs b/Emulsion.Tests/Xmpp/XmppClientTests.fs index d9147160..87d89632 100644 --- a/Emulsion.Tests/Xmpp/XmppClientTests.fs +++ b/Emulsion.Tests/Xmpp/XmppClientTests.fs @@ -184,7 +184,7 @@ let ``sendRoomMessage's result doesn't get resolved after receiving other messag let deliveryTask = Async.StartAsTask deliveryInfo.Delivery Assert.False deliveryTask.IsCompleted - let otherMessage = SharpXmppHelper.message (Some "xxx") "nickname@example.org" "foo bar" + let otherMessage = SharpXmppHelper.message "xxx" "nickname@example.org" "foo bar" messageHandler otherMessage Assert.False deliveryTask.IsCompleted ) diff --git a/Emulsion/Xmpp/SharpXmppHelper.fs b/Emulsion/Xmpp/SharpXmppHelper.fs index 450fe82c..bcd3e7ea 100644 --- a/Emulsion/Xmpp/SharpXmppHelper.fs +++ b/Emulsion/Xmpp/SharpXmppHelper.fs @@ -47,10 +47,9 @@ let joinRoom (client: XmppClient) (roomJid: string) (nickname: string): unit = let room = bookmark roomJid nickname client.BookmarkManager.Join(room) -let message (id: string option) (toAddr: string) (text: string): XMPPMessage = - // TODO[F]: Make id a mandatory parameter? +let message (id: string) (toAddr: string) (text: string): XMPPMessage = let m = XMPPMessage() - id |> Option.iter (fun id -> m.SetAttributeValue(Id, id)) + m.SetAttributeValue(Id, id) m.SetAttributeValue(Type, "groupchat") m.SetAttributeValue(To, toAddr) let body = XElement(Body) diff --git a/Emulsion/Xmpp/XmppClient.fs b/Emulsion/Xmpp/XmppClient.fs index eedb3a80..baacffbb 100644 --- a/Emulsion/Xmpp/XmppClient.fs +++ b/Emulsion/Xmpp/XmppClient.fs @@ -116,11 +116,14 @@ let private awaitMessageReceival (client: IXmppClient) (lifetime: Lifetime) mess messageLifetimeDefinition.Dispose() } +let private newMessageId(): string = + Guid.NewGuid().ToString() + /// Sends the message to the room. Returns an object that allows to track the message receival. let sendRoomMessage (client: IXmppClient) (lifetime: Lifetime) (messageInfo: MessageInfo): Async = async { - let messageId = Guid.NewGuid().ToString() // TODO[F]: Move to a new function - let message = SharpXmppHelper.message (Some messageId) messageInfo.RecipientJid.FullJid messageInfo.Text + let messageId = newMessageId() + let message = SharpXmppHelper.message messageId messageInfo.RecipientJid.FullJid messageInfo.Text let! delivery = Async.StartChild <| awaitMessageReceival client lifetime messageId client.Send message return { From 641eb5ad0b85e493ff849bb590f29bd4c3aae780 Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sun, 8 Sep 2019 20:59:43 +0700 Subject: [PATCH 20/22] Small formatting fix for XmppClientTests (#18) --- Emulsion.Tests/Xmpp/XmppClientTests.fs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/Emulsion.Tests/Xmpp/XmppClientTests.fs b/Emulsion.Tests/Xmpp/XmppClientTests.fs index 87d89632..343af396 100644 --- a/Emulsion.Tests/Xmpp/XmppClientTests.fs +++ b/Emulsion.Tests/Xmpp/XmppClientTests.fs @@ -68,12 +68,12 @@ let ``connect function calls the Connect method of the client passed``(): unit = [] let ``connect function returns a lifetime terminated whenever the ConnectionFailed callback is triggered``(): unit = - let mutable callback = ignore - let client = XmppClientFactory.create(addConnectionFailedHandler = fun _ h -> callback <- h) - let lt = Async.RunSynchronously <| XmppClient.connect client - Assert.True lt.IsAlive - callback(ConnFailedArgs()) - Assert.False lt.IsAlive + let mutable callback = ignore + let client = XmppClientFactory.create(addConnectionFailedHandler = fun _ h -> callback <- h) + let lt = Async.RunSynchronously <| XmppClient.connect client + Assert.True lt.IsAlive + callback(ConnFailedArgs()) + Assert.False lt.IsAlive [] let ``enterRoom function calls JoinMultiUserChat``(): unit = From acf2096a2e32eb420bf1abbb71630c35a91a313b Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sun, 8 Sep 2019 21:22:38 +0700 Subject: [PATCH 21/22] Fix leave detection (#18) --- Emulsion.Tests/Xmpp/XmppClientTests.fs | 12 ++++++------ Emulsion/Xmpp/SharpXmppHelper.fs | 7 ++++++- Emulsion/Xmpp/XmppClient.fs | 2 +- 3 files changed, 13 insertions(+), 8 deletions(-) diff --git a/Emulsion.Tests/Xmpp/XmppClientTests.fs b/Emulsion.Tests/Xmpp/XmppClientTests.fs index 343af396..7395937b 100644 --- a/Emulsion.Tests/Xmpp/XmppClientTests.fs +++ b/Emulsion.Tests/Xmpp/XmppClientTests.fs @@ -21,11 +21,11 @@ let private createPresenceFor (roomJid: JID) nickname = presence.SetAttributeValue(From, participantJid.FullJid) presence -let private createSelfPresence roomJid nickname = +let private createSelfPresence roomJid nickname (statusCode: int) = let presence = createPresenceFor roomJid nickname let x = XElement X let status = XElement Status - status.SetAttributeValue(Code, "110") + status.SetAttributeValue(Code, statusCode) x.Add status presence.Add x presence @@ -40,7 +40,7 @@ let private createErrorPresence roomJid nickname errorXml = presence let private createLeavePresence roomJid nickname = - let presence = createSelfPresence roomJid nickname + let presence = createSelfPresence roomJid nickname 307 presence.SetAttributeValue(Type, "unavailable") presence @@ -84,7 +84,7 @@ let ``enterRoom function calls JoinMultiUserChat``(): unit = addPresenceHandler = (fun _ h -> presenceHandlers.Add h), joinMultiUserChat = fun roomJid nickname -> called <- true - Seq.iter (fun h -> h (createSelfPresence roomJid nickname)) presenceHandlers + Seq.iter (fun h -> h (createSelfPresence roomJid nickname 110)) presenceHandlers ) let roomInfo = { RoomJid = JID("room@conference.example.org"); Nickname = "testuser" } Lifetime.Using(fun lt -> @@ -117,7 +117,7 @@ let ``Lifetime returned from enterRoom terminates by a room leave presence``(): XmppClientFactory.create( addPresenceHandler = (fun _ h -> presenceHandlers.Add h), joinMultiUserChat = fun roomJid nickname -> - sendPresence (createSelfPresence roomJid nickname) presenceHandlers + sendPresence (createSelfPresence roomJid nickname 110) presenceHandlers ) let roomInfo = { RoomJid = JID("room@conference.example.org"); Nickname = "testuser" } Lifetime.Using(fun lt -> @@ -134,7 +134,7 @@ let ``Lifetime returned from enterRoom terminates by an external lifetime termin XmppClientFactory.create( addPresenceHandler = (fun _ h -> presenceHandlers.Add h), joinMultiUserChat = fun roomJid nickname -> - sendPresence (createSelfPresence roomJid nickname) presenceHandlers + sendPresence (createSelfPresence roomJid nickname 110) presenceHandlers ) let roomInfo = { RoomJid = JID("room@conference.example.org"); Nickname = "testuser" } use ld = Lifetime.Define() diff --git a/Emulsion/Xmpp/SharpXmppHelper.fs b/Emulsion/Xmpp/SharpXmppHelper.fs index bcd3e7ea..4c52de8e 100644 --- a/Emulsion/Xmpp/SharpXmppHelper.fs +++ b/Emulsion/Xmpp/SharpXmppHelper.fs @@ -31,7 +31,7 @@ module Elements = let Delay = XName.Get("delay", "urn:xmpp:delay") let Error = XName.Get "error" let Nick = XName.Get("nick", Namespaces.StorageBookmarks) - let Status = XName.Get "status" + let Status = XName.Get("status", Namespaces.MucUser) let X = XName.Get("x", Namespaces.MucUser) open Elements @@ -84,6 +84,11 @@ let isGroupChatMessage(message: XMPPMessage): bool = let isEmptyMessage(message: XMPPMessage): bool = String.IsNullOrWhiteSpace message.Text +/// See https://xmpp.org/registrar/mucstatus.html +let private removalCodes = Set.ofArray [| 301; 307; 321; 322; 332 |] +let hasRemovalCode(states: int[]): bool = + states |> Array.exists (fun x -> Set.contains x removalCodes) + let getMessageId(message: XMPPMessage): string option = getAttributeValue message Id diff --git a/Emulsion/Xmpp/XmppClient.fs b/Emulsion/Xmpp/XmppClient.fs index baacffbb..22cf49ca 100644 --- a/Emulsion/Xmpp/XmppClient.fs +++ b/Emulsion/Xmpp/XmppClient.fs @@ -42,7 +42,7 @@ let private isSelfPresence (roomInfo: RoomInfo) (presence: XMPPPresence) = let private isLeavePresence (roomInfo: RoomInfo) (presence: XMPPPresence) = let presence = SharpXmppHelper.parsePresence presence let expectedJid = sprintf "%s/%s" roomInfo.RoomJid.BareJid roomInfo.Nickname - presence.From = expectedJid && Array.contains 110 presence.States && presence.Type = Some "unavailable" + presence.From = expectedJid && presence.Type = Some "unavailable" && SharpXmppHelper.hasRemovalCode presence.States let private extractPresenceException (roomInfo: RoomInfo) (presence: XMPPPresence) = let presence = SharpXmppHelper.parsePresence presence From 37be9f7eb92139c8109adbabfa925256caa7b842 Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sat, 21 Sep 2019 15:58:34 +0700 Subject: [PATCH 22/22] Update JetBrains.Lifetimes to a newer version (#18) --- Emulsion.Tests/LifetimesTests.fs | 9 --------- Emulsion.Tests/Xmpp/EmulsionXmppTests.fs | 2 +- Emulsion/Emulsion.fsproj | 2 +- Emulsion/Lifetimes.fs | 12 ------------ Emulsion/Xmpp/XmppClient.fs | 4 ++-- 5 files changed, 4 insertions(+), 25 deletions(-) diff --git a/Emulsion.Tests/LifetimesTests.fs b/Emulsion.Tests/LifetimesTests.fs index 5962273c..3fec5367 100644 --- a/Emulsion.Tests/LifetimesTests.fs +++ b/Emulsion.Tests/LifetimesTests.fs @@ -7,15 +7,6 @@ open Xunit open System.Threading.Tasks open Emulsion.Lifetimes -[] -let ``nestedTaskCompletionSource getting cancelled after parent lifetime termination``(): unit = - use ld = Lifetime.Define() - let tcs = nestedTaskCompletionSource ld.Lifetime - let task = tcs.Task - Assert.False task.IsCompleted - ld.Terminate() - Assert.Throws(fun () -> task.GetAwaiter().GetResult() |> ignore) |> ignore - [] let ``awaitTermination completes after the parent lifetime is terminated``(): unit = use ld = Lifetime.Define() diff --git a/Emulsion.Tests/Xmpp/EmulsionXmppTests.fs b/Emulsion.Tests/Xmpp/EmulsionXmppTests.fs index ae798154..9ba8d14f 100644 --- a/Emulsion.Tests/Xmpp/EmulsionXmppTests.fs +++ b/Emulsion.Tests/Xmpp/EmulsionXmppTests.fs @@ -146,7 +146,7 @@ type SendTests(outputHelper: ITestOutputHelper) = upcast (async { use ld = Lifetime.Define() let lt = ld.Lifetime - let messageId = nestedTaskCompletionSource lt + let messageId = lt.CreateTaskCompletionSource() let messageHandlers = ResizeArray() let onMessage msg = messageHandlers |> Seq.iter (fun h -> h msg) diff --git a/Emulsion/Emulsion.fsproj b/Emulsion/Emulsion.fsproj index a5551a6d..adb752df 100644 --- a/Emulsion/Emulsion.fsproj +++ b/Emulsion/Emulsion.fsproj @@ -32,7 +32,7 @@ - + diff --git a/Emulsion/Lifetimes.fs b/Emulsion/Lifetimes.fs index 3a31ec4a..26d06fe7 100644 --- a/Emulsion/Lifetimes.fs +++ b/Emulsion/Lifetimes.fs @@ -4,18 +4,6 @@ open System.Threading.Tasks open JetBrains.Lifetimes -/// Creates a task completion source that will be canceled if lifetime terminates before it is completed successfully. -let nestedTaskCompletionSource<'T>(lifetime: Lifetime): TaskCompletionSource<'T> = - let tcs = new TaskCompletionSource<'T>() - - // Register a cancellation action, and remove the action when the task is completed (to not store the unnecessary - // action after we already know it won't cancel the task). - let cancellationToken = lifetime.ToCancellationToken() - let action = cancellationToken.Register(fun () -> tcs.TrySetCanceled() |> ignore) - tcs.Task.ContinueWith(fun (t: Task<'T>) -> action.Dispose()) |> ignore - - tcs - let awaitTermination(lifetime: Lifetime): Async = let tcs = TaskCompletionSource() lifetime.OnTermination(fun () -> tcs.SetResult()) |> ignore diff --git a/Emulsion/Xmpp/XmppClient.fs b/Emulsion/Xmpp/XmppClient.fs index 22cf49ca..d47086ed 100644 --- a/Emulsion/Xmpp/XmppClient.fs +++ b/Emulsion/Xmpp/XmppClient.fs @@ -60,7 +60,7 @@ let enterRoom (client: IXmppClient) (lifetime: Lifetime) (roomInfo: RoomInfo): A let roomLifetimeDefinition = lifetime.CreateNested() let roomLifetime = roomLifetimeDefinition.Lifetime - let tcs = nestedTaskCompletionSource connectionLifetime + let tcs = connectionLifetime.CreateTaskCompletionSource() // Success and error handlers: client.AddPresenceHandler connectionLifetime (fun presence -> @@ -102,7 +102,7 @@ let private awaitMessageReceival (client: IXmppClient) (lifetime: Lifetime) mess // actually sending a message. let messageLifetimeDefinition = lifetime.CreateNested() let messageLifetime = messageLifetimeDefinition.Lifetime - let messageReceivedTask = nestedTaskCompletionSource messageLifetime + let messageReceivedTask = messageLifetime.CreateTaskCompletionSource() client.AddMessageHandler lifetime (fun message -> if hasMessageId messageId message then match extractMessageException message with