From 4118da00a1d242c5a54ead4b9db3c61cbb40a4dc Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sun, 1 Sep 2019 22:06:38 +0700 Subject: [PATCH] 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 +}