Fsharp Websocket Helpers Asp.net Core

Program.fs

namespace fsharp_websocket



module WebsocketHelpers =
    open System
    open System.Net.WebSockets
    open System.Threading
    open Hopac
    let readMessage buffer messageType (stream : #IO.Stream) (socket : WebSocket) =  job {
        let buffer = new ArraySegment<Byte>( Array.create (buffer) Byte.MinValue)

        let rec readTillEnd' () = job {
            let! (result : WebSocketReceiveResult) = socket.ReceiveAsync(buffer,CancellationToken.None)
            if result.MessageType <> messageType then return ()
            stream.Write(buffer.Array,buffer.Offset, result.Count )
            if result.EndOfMessage then
                return ()
            else return! readTillEnd' ()
        }
        do! readTillEnd' ()

        return stream
    }

    let readText buffer socket =
        readMessage buffer WebSocketMessageType.Text (new IO.MemoryStream()) socket
        |> Job.map(
            fun stream ->
                stream.Seek(0L,IO.SeekOrigin.Begin) |> ignore
                let chars =
                    stream.ToArray()
                    //Remove null terminators
                    |> Array.filter(fun x -> x <> '\000'B)
                Text.Encoding.UTF8.GetString(chars)
            )

    let readBinary stream socket =
        readMessage 1500 WebSocketMessageType.Binary stream socket

    let readAsStream (socketJ : unit -> Job<WebSocket>) =
        let generatedStream (websocket : WebSocket) =
            Stream.unfoldJob
                (fun (websocket : WebSocket) ->
                    if websocket.State <> WebSocketState.Closed then
                        readText 1500 websocket
                        |> Job.map(fun text -> Some((websocket,text),websocket))
                    else
                        Job.result None
                ) websocket
        socketJ ()
        |> Job.map(generatedStream)


    let sendMessage buffer messageType (message : #IO.Stream)  (socket : WebSocket)= job {
        let buffer = Array.create (buffer) Byte.MinValue
        let rec sendMessage' () = job {
            let! read = message.ReadAsync(buffer,0,buffer.Length)
            if read > 0 then
                do! socket.SendAsync(ArraySegment(buffer |> Array.take read), messageType, false, CancellationToken.None) |> Job.awaitUnitTask
                return! sendMessage'()
            else
                do! socket.SendAsync(ArraySegment(Array.empty), messageType, true, CancellationToken.None) |> Job.awaitUnitTask
        }

       return! sendMessage'()
    }

    let sendText buffer (text : string) (socket : WebSocket) =
        Job.using
            (new IO.MemoryStream(Text.Encoding.UTF8.GetBytes text))
            (fun memStream -> sendMessage buffer WebSocketMessageType.Text memStream socket)


    let sendBinary stream socket =
        sendMessage 1500 WebSocketMessageType.Binary stream socket

module Main =
    open System
    open System.Net
    open System.Net.WebSockets
    open Microsoft.AspNetCore.Builder
    open Microsoft.AspNetCore.Hosting
    open Microsoft.AspNetCore.Http
    open Hopac
    open System.Threading.Tasks

    let juse (middlware : HttpContext -> (unit -> Job<unit>) -> Job<unit>) (app:IApplicationBuilder) =
        app.Use(
            Func<_,Func<_>,_>(
                fun env next ->
                    middlware env (next.Invoke >> Job.awaitUnitTask)
                    |> Hopac.startAsTask :> Task
    ))

    let handleWebSocket (httpContext : HttpContext) (next : unit -> Job<unit>) = job {
        // ECHO
        if httpContext.WebSockets.IsWebSocketRequest then
            // let! stream = WebsocketHelpers.readAsStream (httpContext.WebSockets.AcceptWebSocketAsync >> Job.awaitTask)
            // do! stream
            //     |> Stream.iterJob(fun (s,t) -> WebsocketHelpers.sendText 1500 t s)

            // do! stream |> Stream.iterFun(printfn "%A")

            let! (websocket : WebSocket) = httpContext.WebSockets.AcceptWebSocketAsync()
            while websocket.State <> WebSocketState.Closed do

                let! text = WebsocketHelpers.readText 1500 websocket

                do! WebsocketHelpers.sendText 1500 text websocket

            ()
        else
            do! next()
    }
    let configure (appBuilder : IApplicationBuilder) =
        appBuilder.UseWebSockets()
        |> juse handleWebSocket
        |> ignore

        ()

    let start (url : string) =
        WebHostBuilder()
            .UseUrls(url)
            .UseKestrel()
            .Configure(fun app -> configure app)
            .Build()
            .Run()

    [<EntryPoint>]
    let main argv =
        printfn "%s" "ALIVE"
        let url = "http://localhost:8079/"
        start url
        0