freac.fs

module Freac
open System.Net
open System.Net.Sockets
open System.Threading

type System.Net.Sockets.Socket with
  member this.AsyncAccept() =
    Async.FromBeginEnd(this.BeginAccept, this.EndAccept)

let inline (<--) (m:MailboxProcessor<_>) msg = m.Post(msg)
type Agent<'T> = MailboxProcessor<'T>

let requestHandler app =
  Agent<Socket>.Start(fun inbox -> 
    let rec loop() = async {
      use! msg = inbox.Receive()
      printfn "Accepting connection from: %A" msg.RemoteEndPoint
      let buf: byte[] = Array.zeroCreate 1024
      let cnt = msg.Receive(buf)
      printfn "Received:\n%s" (System.Text.Encoding.UTF8.GetString(buf))
      let response: string = app msg
      msg.Send(System.Text.Encoding.UTF8.GetBytes(response)) |> ignore
      msg.Close()
      return! loop() }
    loop() )

let runServer app (listener: Socket) =
  let rec loop() = async {
    let! socket = listener.AsyncAccept()
    requestHandler app <-- socket
    return! loop() } 
  loop()

let createListener (ip:IPAddress) port backlog =
  let listener = new Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.IP)
  let endPoint = IPEndPoint(ip, 8080)
  listener.Bind(endPoint)
  listener.Listen(backlog)
  listener

let listener = createListener IPAddress.Any 8080 1000 
listener |> (runServer (fun _ -> "Hello world!")) |> Async.Start

System.Console.ReadKey() |> ignore
printfn "Done"