HTML5 WebSocket

WebSocket is an HTML5 connectivity technology that enables full-duplex client-server communication for building real-time web applications. WebSocket reduces the latency issues associated with half duplex older HTTP techniques like polling, Comet and streaming by establishing a bidirectional, single-socket connection and reusing it.

This example connects to a remote echo server and enables sending/receiving messages and eventually closing the connection using the WebSocket API.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
module WebSocket =
    open IntelliFactory.WebSharper

    /// Client-side code.
    [<JavaScript>]
    module Client =
        open IntelliFactory.WebSharper.Html
        open IntelliFactory.WebSharper.Html5

        /// Appends a <p> element containing the specified text to the DOM.
        let log text color =
            P [Text text; Attr.Style <| "color: " + color]
            |> (fun p -> ById("ws-log").AppendChild p.Dom)
            |> ignore

        /// Appends a button to the element with the specified id.
        let append id (btn : Element) =
            ById(id).AppendChild(btn.Dom)
            |> ignore

        /// Handles WebSocket events.
        let handleEvents (ws : WebSocket) disconnectBtn sendBtn =
            ws.Onerror <- (fun () -> log "Error" "red")
            ws.Onmessage <- (fun msg -> log ("Received: " + msg.Data.ToString()) "blue")
            ws.Onopen <- (fun () ->
                append "send-btn" sendBtn
                append "btns" disconnectBtn
                log "Connected" "green")
            ws.Onclose <- (fun () ->
                ById("connect-btn").RemoveAttribute "disabled"
                sendBtn.Remove()
                disconnectBtn.Remove()
                log "Disconnected" "rgb(250, 167, 50)")

        /// Creates a WebSocket connection and triggers its event handling.
        let connect (msgText : Element) =
            ById("connect-btn").SetAttribute("disabled", "disabled")
            let ws = WebSocket "ws://echo.websocket.org"
            let sendBtn =
                Button [Text "Send"; Attr.Class "btn btn-primary"]
                |>! OnClick (fun _ _ ->
                    let txt = msgText.Value
                    ws.Send txt
                    log ("Sent: " + txt) "black")
            let disconnectBtn =
                Button [Text "Disconnect"; Attr.Class "btn btn-warning"]
                |>! OnClick (fun _ _ -> ws.Close())
            handleEvents ws disconnectBtn sendBtn

        let main() =
            let msgText = TextArea [Text "Hello WebSocket"; Attr.Id "msg"; Attr.Class "form-control"]
            let logDiv = Div [Attr.Id "ws-log"]
            Div [Attr.Class "row"] -< [
                Div [Attr.Class "col-lg-4"] -< [
                    Div [Attr.Style "margin-bottom: 10px;"; Attr.Id "btns"] -< [
                        Button [Text "Connect"; Attr.Id "connect-btn"; Attr.Class "btn btn-success"; Attr.Style "margin-right: 10px;"]
                        |>! OnClick (fun _ _ -> connect msgText)
                    ]
                    Div [Attr.Class "form-group"] -< [
                        Label [Text "Message:"; Attr.Style "font-weight: bold;"]
                        msgText
                    ]
                    Div [Attr.Id "send-btn"]
                ]
                Div [Attr.Class "col-lg-5"; Attr.Style "border-left: 1px solid lightgray;"] -< [
                    Div [Attr.Style "margin-left: 20px;"] -< [
                        Label [Text "Log:"; Attr.Style "font-weight: bold;"]
                        logDiv
                        Button [Text "Clear"; Attr.Style "margin-top: 10px;"; Attr.Class "btn btn-default"]
                        |>! OnClick (fun _ _ -> logDiv.Html <- "")
                    ]
                ]
            ]

    /// A control for serving the main pagelet.
    type Control() =
        inherit Web.Control()

        [<JavaScript>]
        override __.Body = Client.main() :> _