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
+}