41 people like it.

Async TCP Server

A basic, asynchronous TCP server

 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: 
open System
open System.IO
open System.Net
open System.Net.Sockets
open System.Threading

type Socket with
  member socket.AsyncAccept() = Async.FromBeginEnd(socket.BeginAccept, socket.EndAccept)
  member socket.AsyncReceive(buffer:byte[], ?offset, ?count) =
    let offset = defaultArg offset 0
    let count = defaultArg count buffer.Length
    let beginReceive(b,o,c,cb,s) = socket.BeginReceive(b,o,c,SocketFlags.None,cb,s)
    Async.FromBeginEnd(buffer, offset, count, beginReceive, socket.EndReceive)
  member socket.AsyncSend(buffer:byte[], ?offset, ?count) =
    let offset = defaultArg offset 0
    let count = defaultArg count buffer.Length
    let beginSend(b,o,c,cb,s) = socket.BeginSend(b,o,c,SocketFlags.None,cb,s)
    Async.FromBeginEnd(buffer, offset, count, beginSend, socket.EndSend)

type Server() =
  static member Start(hostname:string, ?port) =
    let ipAddress = Dns.GetHostEntry(hostname).AddressList.[0]
    Server.Start(ipAddress, ?port = port)

  static member Start(?ipAddress, ?port) =
    let ipAddress = defaultArg ipAddress IPAddress.Any
    let port = defaultArg port 80
    let endpoint = IPEndPoint(ipAddress, port)
    let cts = new CancellationTokenSource()
    let listener = new Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp)
    listener.Bind(endpoint)
    listener.Listen(int SocketOptionName.MaxConnections)
    printfn "Started listening on port %d" port
    
    let rec loop() = async {
      printfn "Waiting for request ..."
      let! socket = listener.AsyncAccept()
      printfn "Received request"
      let response = [|
        "HTTP/1.1 200 OK\r\n"B
        "Content-Type: text/plain\r\n"B
        "\r\n"B
        "Hello World!"B |] |> Array.concat
      try
        try
          let! bytesSent = socket.AsyncSend(response)
          printfn "Sent response"
        with e -> printfn "An error occurred: %s" e.Message
      finally
        socket.Shutdown(SocketShutdown.Both)
        socket.Close()
      return! loop() }

    Async.Start(loop(), cancellationToken = cts.Token)
    { new IDisposable with member x.Dispose() = cts.Cancel(); listener.Close() }

// Demo
let disposable = Server.Start(port = 8090)
disposable.Dispose()
namespace System
namespace System.IO
namespace System.Net
namespace System.Net.Sockets
namespace System.Threading
Multiple items
type Socket =
  new : socketInformation:SocketInformation -> Socket + 1 overload
  member Accept : unit -> Socket
  member AcceptAsync : e:SocketAsyncEventArgs -> bool
  member AddressFamily : AddressFamily
  member Available : int
  member BeginAccept : callback:AsyncCallback * state:obj -> IAsyncResult + 2 overloads
  member BeginConnect : remoteEP:EndPoint * callback:AsyncCallback * state:obj -> IAsyncResult + 3 overloads
  member BeginDisconnect : reuseSocket:bool * callback:AsyncCallback * state:obj -> IAsyncResult
  member BeginReceive : buffers:IList<ArraySegment<byte>> * socketFlags:SocketFlags * callback:AsyncCallback * state:obj -> IAsyncResult + 3 overloads
  member BeginReceiveFrom : buffer:byte[] * offset:int * size:int * socketFlags:SocketFlags * remoteEP:EndPoint * callback:AsyncCallback * state:obj -> IAsyncResult
  ...

Full name: System.Net.Sockets.Socket

--------------------
Socket(socketInformation: SocketInformation) : unit
Socket(addressFamily: AddressFamily, socketType: SocketType, protocolType: ProtocolType) : unit
val socket : Socket
member Socket.AsyncAccept : unit -> Async<Socket>

Full name: Script.AsyncAccept
Multiple items
type Async
static member AsBeginEnd : computation:('Arg -> Async<'T>) -> ('Arg * AsyncCallback * obj -> IAsyncResult) * (IAsyncResult -> 'T) * (IAsyncResult -> unit)
static member AwaitEvent : event:IEvent<'Del,'T> * ?cancelAction:(unit -> unit) -> Async<'T> (requires delegate and 'Del :> Delegate)
static member AwaitIAsyncResult : iar:IAsyncResult * ?millisecondsTimeout:int -> Async<bool>
static member AwaitTask : task:Task<'T> -> Async<'T>
static member AwaitWaitHandle : waitHandle:WaitHandle * ?millisecondsTimeout:int -> Async<bool>
static member CancelDefaultToken : unit -> unit
static member Catch : computation:Async<'T> -> Async<Choice<'T,exn>>
static member FromBeginEnd : beginAction:(AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromBeginEnd : arg:'Arg1 * beginAction:('Arg1 * AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromBeginEnd : arg1:'Arg1 * arg2:'Arg2 * beginAction:('Arg1 * 'Arg2 * AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromBeginEnd : arg1:'Arg1 * arg2:'Arg2 * arg3:'Arg3 * beginAction:('Arg1 * 'Arg2 * 'Arg3 * AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromContinuations : callback:(('T -> unit) * (exn -> unit) * (OperationCanceledException -> unit) -> unit) -> Async<'T>
static member Ignore : computation:Async<'T> -> Async<unit>
static member OnCancel : interruption:(unit -> unit) -> Async<IDisposable>
static member Parallel : computations:seq<Async<'T>> -> Async<'T []>
static member RunSynchronously : computation:Async<'T> * ?timeout:int * ?cancellationToken:CancellationToken -> 'T
static member Sleep : millisecondsDueTime:int -> Async<unit>
static member Start : computation:Async<unit> * ?cancellationToken:CancellationToken -> unit
static member StartAsTask : computation:Async<'T> * ?taskCreationOptions:TaskCreationOptions * ?cancellationToken:CancellationToken -> Task<'T>
static member StartChild : computation:Async<'T> * ?millisecondsTimeout:int -> Async<Async<'T>>
static member StartChildAsTask : computation:Async<'T> * ?taskCreationOptions:TaskCreationOptions -> Async<Task<'T>>
static member StartImmediate : computation:Async<unit> * ?cancellationToken:CancellationToken -> unit
static member StartWithContinuations : computation:Async<'T> * continuation:('T -> unit) * exceptionContinuation:(exn -> unit) * cancellationContinuation:(OperationCanceledException -> unit) * ?cancellationToken:CancellationToken -> unit
static member SwitchToContext : syncContext:SynchronizationContext -> Async<unit>
static member SwitchToNewThread : unit -> Async<unit>
static member SwitchToThreadPool : unit -> Async<unit>
static member TryCancelled : computation:Async<'T> * compensation:(OperationCanceledException -> unit) -> Async<'T>
static member CancellationToken : Async<CancellationToken>
static member DefaultCancellationToken : CancellationToken

Full name: Microsoft.FSharp.Control.Async

--------------------
type Async<'T>

Full name: Microsoft.FSharp.Control.Async<_>
static member Async.FromBeginEnd : beginAction:(AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member Async.FromBeginEnd : arg:'Arg1 * beginAction:('Arg1 * AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member Async.FromBeginEnd : arg1:'Arg1 * arg2:'Arg2 * beginAction:('Arg1 * 'Arg2 * AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member Async.FromBeginEnd : arg1:'Arg1 * arg2:'Arg2 * arg3:'Arg3 * beginAction:('Arg1 * 'Arg2 * 'Arg3 * AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
Socket.BeginAccept(callback: AsyncCallback, state: obj) : IAsyncResult
Socket.BeginAccept(receiveSize: int, callback: AsyncCallback, state: obj) : IAsyncResult
Socket.BeginAccept(acceptSocket: Socket, receiveSize: int, callback: AsyncCallback, state: obj) : IAsyncResult
Socket.EndAccept(asyncResult: IAsyncResult) : Socket
Socket.EndAccept(buffer: byref<byte []>, asyncResult: IAsyncResult) : Socket
Socket.EndAccept(buffer: byref<byte []>, bytesTransferred: byref<int>, asyncResult: IAsyncResult) : Socket
member Socket.AsyncReceive : buffer:byte [] * ?offset:int * ?count:int -> Async<int>

Full name: Script.AsyncReceive
val buffer : byte []
Multiple items
val byte : value:'T -> byte (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.byte

--------------------
type byte = Byte

Full name: Microsoft.FSharp.Core.byte
val offset : int option
val count : int option
val offset : int
val defaultArg : arg:'T option -> defaultValue:'T -> 'T

Full name: Microsoft.FSharp.Core.Operators.defaultArg
val count : int
property Array.Length: int
val beginReceive : (byte [] * int * int * AsyncCallback * 'a -> IAsyncResult)
val b : byte []
val o : int
val c : int
val cb : AsyncCallback
val s : 'a
Socket.BeginReceive(buffers: Collections.Generic.IList<ArraySegment<byte>>, socketFlags: SocketFlags, callback: AsyncCallback, state: obj) : IAsyncResult
Socket.BeginReceive(buffers: Collections.Generic.IList<ArraySegment<byte>>, socketFlags: SocketFlags, errorCode: byref<SocketError>, callback: AsyncCallback, state: obj) : IAsyncResult
Socket.BeginReceive(buffer: byte [], offset: int, size: int, socketFlags: SocketFlags, callback: AsyncCallback, state: obj) : IAsyncResult
Socket.BeginReceive(buffer: byte [], offset: int, size: int, socketFlags: SocketFlags, errorCode: byref<SocketError>, callback: AsyncCallback, state: obj) : IAsyncResult
type SocketFlags =
  | None = 0
  | OutOfBand = 1
  | Peek = 2
  | DontRoute = 4
  | MaxIOVectorLength = 16
  | Truncated = 256
  | ControlDataTruncated = 512
  | Broadcast = 1024
  | Multicast = 2048
  | Partial = 32768

Full name: System.Net.Sockets.SocketFlags
field SocketFlags.None = 0
Socket.EndReceive(asyncResult: IAsyncResult) : int
Socket.EndReceive(asyncResult: IAsyncResult, errorCode: byref<SocketError>) : int
member Socket.AsyncSend : buffer:byte [] * ?offset:int * ?count:int -> Async<int>

Full name: Script.AsyncSend
val beginSend : (byte [] * int * int * AsyncCallback * 'a -> IAsyncResult)
Socket.BeginSend(buffers: Collections.Generic.IList<ArraySegment<byte>>, socketFlags: SocketFlags, callback: AsyncCallback, state: obj) : IAsyncResult
Socket.BeginSend(buffers: Collections.Generic.IList<ArraySegment<byte>>, socketFlags: SocketFlags, errorCode: byref<SocketError>, callback: AsyncCallback, state: obj) : IAsyncResult
Socket.BeginSend(buffer: byte [], offset: int, size: int, socketFlags: SocketFlags, callback: AsyncCallback, state: obj) : IAsyncResult
Socket.BeginSend(buffer: byte [], offset: int, size: int, socketFlags: SocketFlags, errorCode: byref<SocketError>, callback: AsyncCallback, state: obj) : IAsyncResult
Socket.EndSend(asyncResult: IAsyncResult) : int
Socket.EndSend(asyncResult: IAsyncResult, errorCode: byref<SocketError>) : int
Multiple items
type Server =
  new : unit -> Server
  static member Start : hostname:string * ?port:int -> IDisposable
  static member Start : ?ipAddress:IPAddress * ?port:int -> IDisposable

Full name: Script.Server

--------------------
new : unit -> Server
static member Server.Start : hostname:string * ?port:int -> IDisposable

Full name: Script.Server.Start
val hostname : string
Multiple items
val string : value:'T -> string

Full name: Microsoft.FSharp.Core.Operators.string

--------------------
type string = String

Full name: Microsoft.FSharp.Core.string
val port : int option
val ipAddress : IPAddress
type Dns =
  static member BeginGetHostAddresses : hostNameOrAddress:string * requestCallback:AsyncCallback * state:obj -> IAsyncResult
  static member BeginGetHostByName : hostName:string * requestCallback:AsyncCallback * stateObject:obj -> IAsyncResult
  static member BeginGetHostEntry : hostNameOrAddress:string * requestCallback:AsyncCallback * stateObject:obj -> IAsyncResult + 1 overload
  static member BeginResolve : hostName:string * requestCallback:AsyncCallback * stateObject:obj -> IAsyncResult
  static member EndGetHostAddresses : asyncResult:IAsyncResult -> IPAddress[]
  static member EndGetHostByName : asyncResult:IAsyncResult -> IPHostEntry
  static member EndGetHostEntry : asyncResult:IAsyncResult -> IPHostEntry
  static member EndResolve : asyncResult:IAsyncResult -> IPHostEntry
  static member GetHostAddresses : hostNameOrAddress:string -> IPAddress[]
  static member GetHostByAddress : address:string -> IPHostEntry + 1 overload
  ...

Full name: System.Net.Dns
Dns.GetHostEntry(address: IPAddress) : IPHostEntry
Dns.GetHostEntry(hostNameOrAddress: string) : IPHostEntry
static member Server.Start : hostname:string * ?port:int -> IDisposable
static member Server.Start : ?ipAddress:IPAddress * ?port:int -> IDisposable
static member Server.Start : ?ipAddress:IPAddress * ?port:int -> IDisposable

Full name: Script.Server.Start
val ipAddress : IPAddress option
Multiple items
type IPAddress =
  new : newAddress:int64 -> IPAddress + 2 overloads
  member Address : int64 with get, set
  member AddressFamily : AddressFamily
  member Equals : comparand:obj -> bool
  member GetAddressBytes : unit -> byte[]
  member GetHashCode : unit -> int
  member IsIPv6LinkLocal : bool
  member IsIPv6Multicast : bool
  member IsIPv6SiteLocal : bool
  member IsIPv6Teredo : bool
  ...

Full name: System.Net.IPAddress

--------------------
IPAddress(newAddress: int64) : unit
IPAddress(address: byte []) : unit
IPAddress(address: byte [], scopeid: int64) : unit
field IPAddress.Any
val port : int
val endpoint : IPEndPoint
Multiple items
type IPEndPoint =
  inherit EndPoint
  new : address:int64 * port:int -> IPEndPoint + 1 overload
  member Address : IPAddress with get, set
  member AddressFamily : AddressFamily
  member Create : socketAddress:SocketAddress -> EndPoint
  member Equals : comparand:obj -> bool
  member GetHashCode : unit -> int
  member Port : int with get, set
  member Serialize : unit -> SocketAddress
  member ToString : unit -> string
  static val MinPort : int
  ...

Full name: System.Net.IPEndPoint

--------------------
IPEndPoint(address: int64, port: int) : unit
IPEndPoint(address: IPAddress, port: int) : unit
val cts : CancellationTokenSource
Multiple items
type CancellationTokenSource =
  new : unit -> CancellationTokenSource
  member Cancel : unit -> unit + 1 overload
  member Dispose : unit -> unit
  member IsCancellationRequested : bool
  member Token : CancellationToken
  static member CreateLinkedTokenSource : [<ParamArray>] tokens:CancellationToken[] -> CancellationTokenSource + 1 overload

Full name: System.Threading.CancellationTokenSource

--------------------
CancellationTokenSource() : unit
val listener : Socket
type AddressFamily =
  | Unknown = -1
  | Unspecified = 0
  | Unix = 1
  | InterNetwork = 2
  | ImpLink = 3
  | Pup = 4
  | Chaos = 5
  | NS = 6
  | Ipx = 6
  | Iso = 7
  ...

Full name: System.Net.Sockets.AddressFamily
field AddressFamily.InterNetwork = 2
type SocketType =
  | Stream = 1
  | Dgram = 2
  | Raw = 3
  | Rdm = 4
  | Seqpacket = 5
  | Unknown = -1

Full name: System.Net.Sockets.SocketType
field SocketType.Stream = 1
type ProtocolType =
  | IP = 0
  | IPv6HopByHopOptions = 0
  | Icmp = 1
  | Igmp = 2
  | Ggp = 3
  | IPv4 = 4
  | Tcp = 6
  | Pup = 12
  | Udp = 17
  | Idp = 22
  ...

Full name: System.Net.Sockets.ProtocolType
field ProtocolType.Tcp = 6
Socket.Bind(localEP: EndPoint) : unit
Socket.Listen(backlog: int) : unit
Multiple items
val int : value:'T -> int (requires member op_Explicit)

Full name: Microsoft.FSharp.Core.Operators.int

--------------------
type int = int32

Full name: Microsoft.FSharp.Core.int

--------------------
type int<'Measure> = int

Full name: Microsoft.FSharp.Core.int<_>
type SocketOptionName =
  | Debug = 1
  | AcceptConnection = 2
  | ReuseAddress = 4
  | KeepAlive = 8
  | DontRoute = 16
  | Broadcast = 32
  | UseLoopback = 64
  | Linger = 128
  | OutOfBandInline = 256
  | DontLinger = -129
  ...

Full name: System.Net.Sockets.SocketOptionName
field SocketOptionName.MaxConnections = 2147483647
val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn
val loop : (unit -> Async<'a>)
val async : AsyncBuilder

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.async
member Socket.AsyncAccept : unit -> Async<Socket>
val response : byte []
type Array =
  member Clone : unit -> obj
  member CopyTo : array:Array * index:int -> unit + 1 overload
  member GetEnumerator : unit -> IEnumerator
  member GetLength : dimension:int -> int
  member GetLongLength : dimension:int -> int64
  member GetLowerBound : dimension:int -> int
  member GetUpperBound : dimension:int -> int
  member GetValue : [<ParamArray>] indices:int[] -> obj + 7 overloads
  member Initialize : unit -> unit
  member IsFixedSize : bool
  ...

Full name: System.Array
val concat : arrays:seq<'T []> -> 'T []

Full name: Microsoft.FSharp.Collections.Array.concat
val bytesSent : int
member Socket.AsyncSend : buffer:byte [] * ?offset:int * ?count:int -> Async<int>
val e : exn
property Exception.Message: string
Socket.Shutdown(how: SocketShutdown) : unit
type SocketShutdown =
  | Receive = 0
  | Send = 1
  | Both = 2

Full name: System.Net.Sockets.SocketShutdown
field SocketShutdown.Both = 2
Socket.Close() : unit
Socket.Close(timeout: int) : unit
static member Async.Start : computation:Async<unit> * ?cancellationToken:CancellationToken -> unit
property CancellationTokenSource.Token: CancellationToken
type IDisposable =
  member Dispose : unit -> unit

Full name: System.IDisposable
val x : IDisposable
IDisposable.Dispose() : unit
CancellationTokenSource.Cancel() : unit
CancellationTokenSource.Cancel(throwOnFirstException: bool) : unit
val disposable : IDisposable

Full name: Script.disposable

More information

Link:http://fssnip.net/1E
Posted:13 years ago
Author:Ryan Riley
Tags: server , tcp , async , socket