Implement lifetimes and SharpXmppClient.signIn (#18)

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 =

Emulsion/Emulsion.fsproj

@@ -11,13 +11,17 @@
     <Compile Include="MessageSender.fs" />
     <Compile Include="MessageSystem.fs" />
     <Compile Include="Logging.fs" />
+    <Compile Include="Lifetimes.fs" />
+    <Compile Include="ExceptionUtils.fs" />
     <Compile Include="Telegram\Html.fs" />
     <Compile Include="Telegram\Funogram.fs" />
     <Compile Include="Telegram\Client.fs" />
+    <Compile Include="Xmpp\XmppElements.fs" />
     <Compile Include="Xmpp/SharpXmppHelper.fs" />
     <Compile Include="Xmpp/XmppClient.fs" />
     <Compile Include="Xmpp\Client.fs" />
     <Compile Include="Xmpp\AsyncXmppClient.fs" />
+    <Compile Include="Xmpp\SharpXmppClient.fs" />
     <Compile Include="Actors/Factories.fs" />
     <Compile Include="Actors/Core.fs" />
     <Compile Include="Actors/Telegram.fs" />

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"

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

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<unit> // 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<Lifetime>
-
-    /// Sign in with the provided credentials. Returns a session lifetime that will terminate if the session terminates.
-    abstract member SignIn : SignInInfo -> Async<Lifetime>
+    // 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<Lifetime>

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<XmppClient * Lifetime> = 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<Lifetime> = 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
+}

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 }

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