Yaaf.Xmpp.Runtime example

sample.fsx

// do note that you'll need to include dependencies in here
module GoogleMessages =
    open Yaaf.Xmpp.Runtime
    open FSharp.Data

    /// types around the messages visible to a mobile client
    module ClientFacing =
        /// an upstream message is a message that came from a mobile device or web browser
        type Upstream = {
            From : string
            Category : string
            MessageId : string
            Data : Map<string,JsonValue>
        }
        
        /// an Ack is a signal that we processed the message specified
        type Ack = {
            To : string
            MessageId : string
         }

     /// system messages the server gets from Firebase XMPP
    module Control =
        /// never different than SentToDevice
        type ReceiptMessageStatus = | SentToDevice
        with static member TryParse s = 
                if s = "MESSAGE_SENT_TO_DEVICE" then Some SentToDevice else None
        
        /// the server will ask for receipt of particular messages sometimes
        type Receipt = {
            From : string
            MessageId : string
            Category : string option
            MessageStatus : ReceiptMessageStatus option
            OriginalMessageId : string option
            DeviceRegistrationId : string option
        } 
        
        /// the server is telling us to disconnect and reconnect
        type ControlType = | ConnectionDraining
        with static member TryParse s = if s = "CONNECTION_DRAINING" then Some ConnectionDraining else None
        
        type Control = {
            Type : ControlType
        }
        type CCS = | Receipt of Receipt | Control of Control

    /// functions that try to extract out google's JSON messages from a particular XMPP-XML stanza
    module Parsing = 
        open ClientFacing
        open Control
        open Yaaf.Xml
        open Yaaf.Helper
        open Yaaf.Xmpp.XmlStanzas
        open Yaaf.Xmpp.XmlStanzas.Parsing
        open Yaaf.Xmpp.XmlStanzas.StanzaParseException
        open FSharp.Data

        let ns = "google:mobile:data" 
        let gcmNodeName = getXName "gcm" ns 

        /// an IStanza is an XMPP stanza that the library has parsed for us
        let isMessage (stanza : IStanza) = stanza.Header.StanzaType = XmlStanzaType.Message

        let tryGetChild name (stanza : IStanza) = 
            stanza.Contents.Children 
            |> Seq.tryHead 
            |> Option.bind (fun (el : System.Xml.Linq.XElement) -> if el.Name = name then Some el else None )

        /// a google message has only one chile, 'gcm'
        let isGoogleMessage (stanza : IStanza) = 
            isMessage stanza 
            && stanza.Contents.Children.Length = 1
            && (stanza.Contents.Children.[0]).Name = getXName "gcm" ns

        let tryGetMessageBody (stanza : IStanza) =
            stanza 
            |> tryGetChild gcmNodeName 
            |> Option.map (fun el -> el.FirstNode.ToString()) 
            |> Option.map JsonValue.Parse
        
        let toMap json : Map<string,JsonValue> =
            match json with
            | JsonValue.Record r ->
                r |> Array.fold (fun m (k,v) -> m |> Map.add k v ) Map.empty 
            | _ -> Map.empty

        let jsonString (v:JsonValue) = v.AsString()
        let isReceipt (data : Map<string,JsonValue>) =
            match data |> Map.tryFind "message_type" with
            | Some (JsonValue.String s) when s = "receipt" -> true
            | _ -> false
        
        let isControl (data : Map<string, JsonValue>) = 
            match data |> Map.tryFind "message_type" with
            | Some (JsonValue.String s) when s = "control" -> true
            | _ -> false
        
        /// try to parse out all receipt members from a json blob
        let parseReceipt (data : Map<string,JsonValue>) : Receipt =
            let dataNode = data |> Map.tryFind "data" |> Option.map toMap

            {   From = data |> Map.find "from" |> jsonString
                MessageId = data |> Map.find "message_id" |> jsonString
                Category = data |> Map.tryFind "category" |> Option.map jsonString
                MessageStatus = 
                    dataNode 
                    |> Option.bind (Map.tryFind "message_status") 
                    |> Option.bind (jsonString >> ReceiptMessageStatus.TryParse)
                OriginalMessageId = dataNode |> Option.bind (Map.tryFind "original_message_id") |> Option.map jsonString
                DeviceRegistrationId = dataNode |> Option.bind (Map.tryFind "device_registration_id") |> Option.map jsonString }
        
        let parseControl data : Control = 
            data |> Map.tryFind "control_type" |> Option.bind (jsonString >> ControlType.TryParse) |> Option.get |> fun c -> {Control.Type = c }

        let parseUpstream (data : Map<string, JsonValue>) : Upstream = 
            {   From = data |> Map.find "from" |> jsonString
                Category = data |> Map.find "category" |> jsonString
                MessageId = data |> Map.find "message_id" |> jsonString
                Data = defaultArg (data |> Map.tryFind "data" |> Option.map toMap) Map.empty }

        let isUpstreamMessage data = not <| isControl data && not <| isReceipt data  

/// uses the datatypes and parsing above to implement a service that can notify of receipt of google XMPP messages
module Plugin = 
    open Yaaf.Xmpp.Runtime
    open Yaaf.Xml
    open Yaaf.Xmpp
    open Yaaf.Xmpp.XmlStanzas
    open Yaaf.Helper
    open GoogleMessages
    
    /// this plugin filters out random stanzas and notifies when firebase XMPP messages are received
    type IFirebaseService =
        [<CLIEvent>] abstract ReceiptReceived : IEvent<Control.Receipt>
        [<CLIEvent>] abstract ControlReceived : IEvent<Control.Control>
        [<CLIEvent>] abstract UpstreamReceived : IEvent<ClientFacing.Upstream>

    /// I take in all stanzas, and fire for some subset of them
    type FirebaseMessagePlugin(stanzas : IXmlStanzaService, registrar : IPluginManagerRegistrar) = 
        let receiptReceived = Event<_>()
        let controlReceived = Event<_>()
        let upstreamReceived = Event<_>()

        let stanzaReceived (stanza : Stanza) = 
            if not <| GoogleMessages.Parsing.isGoogleMessage stanza then ()

            let inline handle test parse trigger data = 
                if test data 
                then trigger (parse data)

            /// for each message I get that is a google message, I should fire one of these handlers
            match GoogleMessages.Parsing.tryGetMessageBody stanza |> Option.map GoogleMessages.Parsing.toMap with
            | None -> () 
            | Some data -> 
                handle GoogleMessages.Parsing.isReceipt GoogleMessages.Parsing.parseReceipt receiptReceived.Trigger data
                handle GoogleMessages.Parsing.isControl GoogleMessages.Parsing.parseControl controlReceived.Trigger data                
                handle GoogleMessages.Parsing.isUpstreamMessage GoogleMessages.Parsing.parseUpstream upstreamReceived.Trigger data
        
        let pipeline = {
            new IRawStanzaPlugin with 
                member __.ReceivePipeline = 
                    { Pipeline.empty "Google Firebase plugin" with 
                            HandlerState = fun _ -> HandlerState.ExecuteUnhandled
                            Process = 
                                fun info -> async {
                                                let elem = info.Result.Element
                                                stanzaReceived elem
                                            } |> Async.StartAsTaskImmediate  
                    } :> _
        }

        interface IFirebaseService with
            [<CLIEventAttribute>] member __.ReceiptReceived = receiptReceived.Publish
            [<CLIEventAttribute>] member __.ControlReceived = controlReceived.Publish
            [<CLIEventAttribute>] member __.UpstreamReceived = upstreamReceived.Publish
    
        interface IXmppPlugin with
            member __.Name = "Firebase Console Plugin"
            member x.PluginService = Service.FromInstance<IFirebaseService, _> x

/// Everything below this is samples of how you'd use it

let host = "fcm-xmpp.googleapis.com"
let testGooglePort = 5236
let prodGooglePort = 5235
let userId = "XXXXX" //TODO: provide your own
let serverSecret = "XXXX" //TODO: provide your own
let test = true
let userIdDomain = "gcm.googleapis.com"

open Yaaf.Xmpp
open Yaaf.Sasl
open Yaaf.Logging
open Yaaf.Xmpp.XmppSetup
open Yaaf.Xmpp.Runtime.Features
open System.Security.Cryptography.X509Certificates
open Yaaf.FSharp.Control.AsyncSeq
open Yaaf.FSharp.Control
open Yaaf.Xmpp.Runtime
open System.Net.Sockets
open System.Net


let jid : JabberId = JabberId.Parse <| sprintf "%[email protected]" userId
let mech : IClientMechanism = Yaaf.Sasl.Plain.PlainClient("0", (sprintf "%s@%s" userId userIdDomain), serverSecret) :> _
let connectInfo : ConnectInfo = { LocalJid = jid; Login = [ mech ];}

let addExtensions (setup: ClientSetup) = 
    let addToRuntime (runtime : XmppRuntime) = 
        runtime.PluginManager.RegisterPlugin<Plugin.FirebaseMessagePlugin>()
    addHelper ignore addToRuntime setup

/// here we configure our new firebase plugin
let clientSetup = XmppSetup.CreateSetup() |> addCoreClient |> addExtensions
/// here we connect to firebase xmpp
 let client = XmppClient.Connect(connectInfo, testGooglePort, clientSetup) |> Async.RunSynchronously |> fun x -> x :> IXmppClient

/// now that we're connected we can get our firebase service and hook up event handlers to the various messages
let firebase = client.GetService<Plugin.IFirebaseService>()
firebase.UpstreamReceived.Add (printfn "%O")
firebase.ControlReceived.Add (printfn "%O")
firebase.ReceiptReceived.Add (printfn "%O")