diff --git a/Emulsion/MessageSystem.fs b/Emulsion/MessageSystem.fs index f63dffbd..87d71b12 100644 --- a/Emulsion/MessageSystem.fs +++ b/Emulsion/MessageSystem.fs @@ -46,6 +46,8 @@ type MessageSystemBase(ctx: RestartContext, cancellationToken: CancellationToken /// Starts the IM connection, manages reconnects. On cancellation could either throw OperationCanceledException or /// return a unit. + /// + /// This method will never be called multiple times in parallel on a single instance. abstract member RunUntilError : IncomingMessageReceiver -> Async /// Sends a message through the message system. Free-threaded. Could throw exceptions; if throws an exception, then diff --git a/Emulsion/Xmpp/Client.fs b/Emulsion/Xmpp/Client.fs index 16777556..98c052f1 100644 --- a/Emulsion/Xmpp/Client.fs +++ b/Emulsion/Xmpp/Client.fs @@ -8,11 +8,21 @@ open Emulsion.Settings type Client(ctx: RestartContext, cancellationToken: CancellationToken, settings: XmppSettings) = inherit MessageSystemBase(ctx, cancellationToken) - let client = XmppClient.create settings - override __.RunUntilError receiver = - XmppClient.run settings client receiver + let client = ref None + + override __.RunUntilError receiver = async { + use newClient = XmppClient.create settings receiver + try + Volatile.Write(client, Some newClient) + do! XmppClient.run newClient + finally + Volatile.Write(client, None) + } override __.Send (OutgoingMessage message) = async { - return XmppClient.send settings client message + match Volatile.Read(client) with + | None -> failwith "Client is offline" + | Some client -> + return XmppClient.send settings client message } diff --git a/Emulsion/Xmpp/XmppClient.fs b/Emulsion/Xmpp/XmppClient.fs index fb5937ad..d69ab0b4 100644 --- a/Emulsion/Xmpp/XmppClient.fs +++ b/Emulsion/Xmpp/XmppClient.fs @@ -33,12 +33,13 @@ let private elementHandler = XmppConnection.ElementHandler(fun s e -> let private presenceHandler = XmppConnection.PresenceHandler(fun s e -> printfn "[P]: %A" e) -let create (settings: XmppSettings): XmppClient = - let client = XmppClient(JID(settings.login), settings.password) +let create (settings: XmppSettings) (onMessage: IncomingMessage -> unit): XmppClient = + let client = new XmppClient(JID(settings.login), settings.password) client.add_ConnectionFailed(connectionFailedHandler) client.add_SignedIn(signedInHandler settings client) client.add_Element(elementHandler) client.add_Presence(presenceHandler) + client.add_Message(messageHandler settings onMessage) client exception ConnectionFailedError of string @@ -46,13 +47,12 @@ exception ConnectionFailedError of string override this.ToString() = sprintf "%A" this -let run (settings: XmppSettings) (client: XmppClient) (onMessage: IncomingMessage -> unit): Async = +let run (client: XmppClient): Async = printfn "Bot name: %s" client.Jid.FullJid - let handler = messageHandler settings onMessage - let tcs = TaskCompletionSource() + let connectionFinished = TaskCompletionSource() let connectionFailedHandler = XmppConnection.ConnectionFailedHandler( - fun _ error -> tcs.SetException(ConnectionFailedError error.Message) + fun _ error -> connectionFinished.SetException(ConnectionFailedError error.Message) ) async { @@ -60,14 +60,12 @@ let run (settings: XmppSettings) (client: XmppClient) (onMessage: IncomingMessag let! token = Async.CancellationToken use _ = token.Register(fun () -> client.Close()) - client.add_Message handler client.add_ConnectionFailed connectionFailedHandler do! Async.AwaitTask(client.ConnectAsync token) - do! Async.AwaitTask tcs.Task + do! Async.AwaitTask connectionFinished.Task finally client.remove_ConnectionFailed connectionFailedHandler - client.remove_Message handler } let send (settings: XmppSettings) (client: XmppClient) (message: Message): unit =