7 people like it.

Synchronous, event-based and asynchronous HTTP proxy

This snippet shows the implementation of three HTTP proxy servers in F#. The first is written using simple synchronous style (that isn't scalable). The second version uses event-based approach in the Node.js style, but is difficult to write. The third version uses F# async workflows and is both scalable and easy to write.

Common functions and declarations

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
// Location where the proxy copies content from
let root = "http://msdn.microsoft.com"

// Maps requests from local URL to target URL
let getProxyUrl (ctx:HttpListenerContext) = 
  Uri(root + ctx.Request.Url.PathAndQuery)

// Handle exception - generate page with message
let handleError (ctx:HttpListenerContext) (e:exn) =
  use wr = new StreamWriter(ctx.Response.OutputStream)
  wr.Write("<h1>Request Failed</h1>")
  wr.Write("<p>" + e.Message + "</p>")
  ctx.Response.Close()

// Handle exception asynchronously - generate page with message
let asyncHandleError (ctx:HttpListenerContext) (e:exn) = async {
  use wr = new StreamWriter(ctx.Response.OutputStream)
  wr.Write("<h1>Request Failed</h1>")
  wr.Write("<p>" + e.Message + "</p>")
  ctx.Response.Close() }

Version #1: Synchronous proxy server

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
  /// Handle request on a dedicated thread - This is not 
  /// scalable, because thread may be blocked for long time
  let handleRequest (ctx:HttpListenerContext) =
    let wc = new WebClient()
    try
      let data = wc.DownloadData(getProxyUrl(ctx))
      ctx.Response.OutputStream.Write(data, 0, data.Length)
      ctx.Response.Close()
    with e ->
      handleError ctx e
  
  // Start synchronous HTTP proxy 
  let token = HttpListener.StartSynchronous("http://localhost:8080/", handleRequest)
  token.Cancel()

Version #2: Event-based proxy server

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
  module Wrappers =
    Wrappers that provide event-based network API

  open Wrappers

  /// Handles request using callbacks - This scales well, but the
  /// code is difficult to write, because we need to use callbacks
  /// (This is similar to the style used by Node.js)
  let handleRequestCallback (ctx:HttpListenerContext) =
    let wc = new WebClient()
    wc.DownloadData
      ( getProxyUrl(ctx.Context), 
        success = (fun data ->
          ctx.Response.OutputStream.Write
            ( data, 0, data.Length,
              success = (fun _ -> ctx.Response.Close()),
              error = handleError ctx.Context )),
        error = handleError ctx.Context )

  // Start HTTP proxy that handles requests using callbacks 
  let token = HttpListener.StartSynchronous("http://localhost:8080/", fun ctx ->
    handleRequestCallback(HttpListenerContext(ctx)))
  token.Cancel()

Version #3: Asynchronous proxy server

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
  /// Handles request using asynchronous workflows - We get efficient & scalable
  /// code by wrapping synchronous solution in 'async' block and changing
  /// synchronous primitives to asynchronous (e.g. AsyncWrite)  
  let asyncHandleRequest (ctx:HttpListenerContext) = async {
    let wc = new WebClient()
    try
      let! data = wc.AsyncDownloadData(getProxyUrl(ctx))
      do! ctx.Response.OutputStream.AsyncWrite(data) 
    with e ->
      do! asyncHandleError ctx e }

  // Start HTTP proxy that handles requests asynchronously
  let token = HttpListener.Start("http://localhost:8080/", asyncHandleRequest)
  token.Cancel()
val root : string

Full name: Script.root
val getProxyUrl : ctx:HttpListenerContext -> Uri

Full name: Script.getProxyUrl
val ctx : HttpListenerContext
type HttpListenerContext =
  member Request : HttpListenerRequest
  member Response : HttpListenerResponse
  member User : IPrincipal

Full name: System.Net.HttpListenerContext
Multiple items
type Uri =
  new : uriString:string -> Uri + 5 overloads
  member AbsolutePath : string
  member AbsoluteUri : string
  member Authority : string
  member DnsSafeHost : string
  member Equals : comparand:obj -> bool
  member Fragment : string
  member GetComponents : components:UriComponents * format:UriFormat -> string
  member GetHashCode : unit -> int
  member GetLeftPart : part:UriPartial -> string
  ...

Full name: System.Uri

--------------------
Uri(uriString: string) : unit
Uri(uriString: string, uriKind: UriKind) : unit
Uri(baseUri: Uri, relativeUri: string) : unit
Uri(baseUri: Uri, relativeUri: Uri) : unit
property HttpListenerContext.Request: HttpListenerRequest
property HttpListenerRequest.Url: Uri
property Uri.PathAndQuery: string
val handleError : ctx:HttpListenerContext -> e:exn -> unit

Full name: Script.handleError
val e : exn
type exn = Exception

Full name: Microsoft.FSharp.Core.exn
val wr : StreamWriter
Multiple items
type StreamWriter =
  inherit TextWriter
  new : stream:Stream -> StreamWriter + 6 overloads
  member AutoFlush : bool with get, set
  member BaseStream : Stream
  member Close : unit -> unit
  member Encoding : Encoding
  member Flush : unit -> unit
  member Write : value:char -> unit + 3 overloads
  static val Null : StreamWriter

Full name: System.IO.StreamWriter

--------------------
StreamWriter(stream: Stream) : unit
StreamWriter(path: string) : unit
StreamWriter(stream: Stream, encoding: Text.Encoding) : unit
StreamWriter(path: string, append: bool) : unit
StreamWriter(stream: Stream, encoding: Text.Encoding, bufferSize: int) : unit
StreamWriter(path: string, append: bool, encoding: Text.Encoding) : unit
StreamWriter(path: string, append: bool, encoding: Text.Encoding, bufferSize: int) : unit
property HttpListenerContext.Response: HttpListenerResponse
property HttpListenerResponse.OutputStream: Stream
TextWriter.Write(value: obj) : unit
   (+0 other overloads)
TextWriter.Write(value: decimal) : unit
   (+0 other overloads)
TextWriter.Write(value: float) : unit
   (+0 other overloads)
TextWriter.Write(value: float32) : unit
   (+0 other overloads)
TextWriter.Write(value: uint64) : unit
   (+0 other overloads)
TextWriter.Write(value: int64) : unit
   (+0 other overloads)
TextWriter.Write(value: uint32) : unit
   (+0 other overloads)
TextWriter.Write(value: int) : unit
   (+0 other overloads)
TextWriter.Write(value: bool) : unit
   (+0 other overloads)
StreamWriter.Write(value: string) : unit
   (+0 other overloads)
property Exception.Message: string
HttpListenerResponse.Close() : unit
HttpListenerResponse.Close(responseEntity: byte [], willBlock: bool) : unit
val asyncHandleError : ctx:HttpListenerContext -> e:exn -> Async<unit>

Full name: Script.asyncHandleError
val async : AsyncBuilder

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.async
val handleRequest : ctx:HttpListenerContext -> unit

Full name: Script.Synchronous.handleRequest


 Handle request on a dedicated thread - This is not
 scalable, because thread may be blocked for long time
val wc : WebClient
Multiple items
type WebClient =
  inherit Component
  new : unit -> WebClient
  member BaseAddress : string with get, set
  member CachePolicy : RequestCachePolicy with get, set
  member CancelAsync : unit -> unit
  member Credentials : ICredentials with get, set
  member DownloadData : address:string -> byte[] + 1 overload
  member DownloadDataAsync : address:Uri -> unit + 1 overload
  member DownloadFile : address:string * fileName:string -> unit + 1 overload
  member DownloadFileAsync : address:Uri * fileName:string -> unit + 1 overload
  member DownloadString : address:string -> string + 1 overload
  ...

Full name: System.Net.WebClient

--------------------
WebClient() : unit
val data : byte []
WebClient.DownloadData(address: Uri) : byte []
WebClient.DownloadData(address: string) : byte []
Stream.Write(buffer: byte [], offset: int, count: int) : unit
property Array.Length: int
val token : CancellationTokenSource

Full name: Script.Synchronous.token
Multiple items
type HttpListener =
  new : unit -> HttpListener
  member Abort : unit -> unit
  member AuthenticationSchemeSelectorDelegate : AuthenticationSchemeSelector with get, set
  member AuthenticationSchemes : AuthenticationSchemes with get, set
  member BeginGetContext : callback:AsyncCallback * state:obj -> IAsyncResult
  member Close : unit -> unit
  member DefaultServiceNames : ServiceNameCollection
  member EndGetContext : asyncResult:IAsyncResult -> HttpListenerContext
  member ExtendedProtectionPolicy : ExtendedProtectionPolicy with get, set
  member ExtendedProtectionSelectorDelegate : ExtendedProtectionSelector with get, set
  ...
  nested type ExtendedProtectionSelector

Full name: System.Net.HttpListener

--------------------
HttpListener() : unit
static member HttpListener.StartSynchronous : url:string * f:(HttpListenerContext -> unit) -> CancellationTokenSource


 Starts an HTTP server on the specified URL with the
 specified synchronous function for handling requests
CancellationTokenSource.Cancel() : unit
CancellationTokenSource.Cancel(throwOnFirstException: bool) : unit
type Stream(stream:IO.Stream) =
      /// Writes data to stream. Calls 'success' callback when
      /// completed or 'error' callback when error occurs.
      member x.Write(buffer, offset, count, success, error) =
        stream.BeginWrite(buffer, offset, count, (fun ar ->
          try success(stream.EndRead(ar))
          with e -> error(e)), null) |> ignore

    type HttpListenerResponse(rsp:System.Net.HttpListenerResponse) =
      member x.OutputStream = Stream(rsp.OutputStream)
      member x.Close() = rsp.Close()

    type HttpListenerContext(ctx:System.Net.HttpListenerContext) =
      member x.Response = HttpListenerResponse(ctx.Response)
      member x.Request = ctx.Request
      member x.Context = ctx

    type WebClient() =
      let wc = new System.Net.WebClient()
      /// Downloads data and calls the 'success' callback when the
      /// download completes or 'error' callback if error occurs.
      member x.DownloadData(uri:Uri, success, error) =
        wc.DownloadDataCompleted.Add(fun res ->
          if res.Error <> null then error res.Error
          else success res.Result)
        wc.DownloadDataAsync(uri)
module Wrappers

from Script.EventBased
val handleRequestCallback : ctx:HttpListenerContext -> unit

Full name: Script.EventBased.handleRequestCallback


 Handles request using callbacks - This scales well, but the
 code is difficult to write, because we need to use callbacks
 (This is similar to the style used by Node.js)
Multiple items
type HttpListenerContext =
  new : ctx:HttpListenerContext -> HttpListenerContext
  member Context : HttpListenerContext
  member Request : HttpListenerRequest
  member Response : HttpListenerResponse

Full name: Script.EventBased.Wrappers.HttpListenerContext

--------------------
new : ctx:HttpListenerContext -> HttpListenerContext
Multiple items
type WebClient =
  new : unit -> WebClient
  member DownloadData : uri:Uri * success:(byte [] -> unit) * error:(exn -> unit) -> unit

Full name: Script.EventBased.Wrappers.WebClient

--------------------
new : unit -> WebClient
member WebClient.DownloadData : uri:Uri * success:(byte [] -> unit) * error:(exn -> unit) -> unit


 Downloads data and calls the 'success' callback when the
 download completes or 'error' callback if error occurs.
property HttpListenerContext.Context: HttpListenerContext
member Stream.Write : buffer:byte [] * offset:int * count:int * success:(int -> unit) * error:(exn -> unit) -> unit


 Writes data to stream. Calls 'success' callback when
 completed or 'error' callback when error occurs.
member HttpListenerResponse.Close : unit -> unit
val token : CancellationTokenSource

Full name: Script.EventBased.token
val asyncHandleRequest : ctx:HttpListenerContext -> Async<unit>

Full name: Script.Async.asyncHandleRequest


 Handles request using asynchronous workflows - We get efficient & scalable
 code by wrapping synchronous solution in 'async' block and changing
 synchronous primitives to asynchronous (e.g. AsyncWrite)
member WebClient.AsyncDownloadData : uri:Uri -> Async<byte []>


 Asynchronously downloads data from the
member Stream.AsyncWrite : buffer:byte [] * ?offset:int * ?count:int -> Async<unit>
val token : CancellationTokenSource

Full name: Script.Async.token
static member HttpListener.Start : url:string * f:(HttpListenerContext -> Async<unit>) -> CancellationTokenSource


 Starts an HTTP server on the specified URL with the
 specified asynchronous function for handling requests

More information

Link:http://fssnip.net/6e
Posted:13 years ago
Author:Tomas Petricek
Tags: async , asynchronous , proxy server , http