56 people like it.

Composable WCF Web API using Async

A functional wrapper around the new WCF Web APIs (http://wcf.codeplex.com/). Composition is achieved through the use of the HttpRequestMessage -> Async signature. Pushing the app calls in the MessageHandler intercepts all requests and allows you to take control at the earliest point possible before operation selection occurs. Extending this slightly to call the innerChannel's SendAsync would allow you to create a middleware layer that would work both with this and other, normal Web API services.

The wrapper type declarations

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
[<ServiceContract>]
type EmptyService() =
  [<OperationContract>]
  member x.Invoke() = ()

type private FrankChannel(innerChannel) =
  inherit DelegatingChannel(innerChannel)

let private webApi app = fun inner ->
  { new FrankChannel(inner) with
      override this.SendAsync(request, cancellationToken) =
        Async.StartAsTask(app request, cancellationToken = cancellationToken) } :> HttpMessageChannel

let frank app =
  HttpHostConfiguration.Create()
    .AddMessageHandlers(typeof<FrankChannel>)
    .SetMessageHandlerFactory(webApi app)

Self-host sample

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
[<EntryPoint>]
let main args =
  let app request = async {
    return new HttpResponseMessage(HttpStatusCode.OK, "OK", Content = new ObjectContent<string>("Hello, world!\n")) }

  let baseUri = Uri "http://localhost:1000/"
  let host = new HttpConfigurableServiceHost<EmptyService>(frank app, [| baseUri |])
  host.Open()

  printfn "Host open.  Hit enter to exit..."
  printfn "Use a web browser and go to %Aroot or do it right and get fiddler!" baseUri
  System.Console.Read() |> ignore

  host.Close()
  0

ASP.NET Routing sample

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
type Global() =
  inherit System.Web.HttpApplication() 

  static member RegisterRoutes(routes:RouteCollection) =
    // Echo the request body contents back to the sender. 
    // Use Fiddler to post a message and see it return.
    let app request = async {
      return new HttpResponseMessage(HttpStatusCode.OK, "OK", Content = new ObjectContent<string>("Hello, world!\n")) }

    // Uses the head middleware.
    // Try using Fiddler and perform a HEAD request.
    routes.MapServiceRoute<EmptyService>("hello", frank app)

  member x.Start() =
    Global.RegisterRoutes(RouteTable.Routes)
Multiple items
type EmptyService =
  new : unit -> EmptyService
  member Invoke : unit -> unit

Full name: Frank.Hosting.Wcf.EmptyService

--------------------
new : unit -> EmptyService
val x : EmptyService
member EmptyService.Invoke : unit -> unit

Full name: Frank.Hosting.Wcf.EmptyService.Invoke
Multiple items
type private FrankChannel =
  inherit obj
  new : innerChannel:'c -> FrankChannel

Full name: Frank.Hosting.Wcf.FrankChannel

--------------------
private new : innerChannel:'c -> FrankChannel
val innerChannel : 'c
val private webApi : app:('a -> Async<'b>) -> inner:'c -> 'd

Full name: Frank.Hosting.Wcf.webApi
val app : ('a -> Async<'b>)
val inner : 'c
val this : FrankChannel
val request : 'a
val cancellationToken : Threading.CancellationToken
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.StartAsTask : computation:Async<'T> * ?taskCreationOptions:Threading.Tasks.TaskCreationOptions * ?cancellationToken:Threading.CancellationToken -> Threading.Tasks.Task<'T>
val frank : app:'a -> 'b

Full name: Frank.Hosting.Wcf.frank
val app : 'a
val typeof<'T> : Type

Full name: Microsoft.FSharp.Core.Operators.typeof
Multiple items
type EntryPointAttribute =
  inherit Attribute
  new : unit -> EntryPointAttribute

Full name: Microsoft.FSharp.Core.EntryPointAttribute

--------------------
new : unit -> EntryPointAttribute
val async : AsyncBuilder

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.async
type HttpStatusCode =
  | Continue = 100
  | SwitchingProtocols = 101
  | OK = 200
  | Created = 201
  | Accepted = 202
  | NonAuthoritativeInformation = 203
  | NoContent = 204
  | ResetContent = 205
  | PartialContent = 206
  | MultipleChoices = 300
  ...

Full name: System.Net.HttpStatusCode
field HttpStatusCode.OK = 200
Multiple items
val string : value:'T -> string

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

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

Full name: Microsoft.FSharp.Core.string
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
val printfn : format:Printf.TextWriterFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.printfn
namespace System
type Console =
  static member BackgroundColor : ConsoleColor with get, set
  static member Beep : unit -> unit + 1 overload
  static member BufferHeight : int with get, set
  static member BufferWidth : int with get, set
  static member CapsLock : bool
  static member Clear : unit -> unit
  static member CursorLeft : int with get, set
  static member CursorSize : int with get, set
  static member CursorTop : int with get, set
  static member CursorVisible : bool with get, set
  ...

Full name: System.Console
Console.Read() : int
val ignore : value:'T -> unit

Full name: Microsoft.FSharp.Core.Operators.ignore
namespace System.Web
Multiple items
type HttpApplication =
  new : unit -> HttpApplication
  member AddOnAcquireRequestStateAsync : bh:BeginEventHandler * eh:EndEventHandler -> unit + 1 overload
  member AddOnAuthenticateRequestAsync : bh:BeginEventHandler * eh:EndEventHandler -> unit + 1 overload
  member AddOnAuthorizeRequestAsync : bh:BeginEventHandler * eh:EndEventHandler -> unit + 1 overload
  member AddOnBeginRequestAsync : bh:BeginEventHandler * eh:EndEventHandler -> unit + 1 overload
  member AddOnEndRequestAsync : bh:BeginEventHandler * eh:EndEventHandler -> unit + 1 overload
  member AddOnLogRequestAsync : bh:BeginEventHandler * eh:EndEventHandler -> unit + 1 overload
  member AddOnMapRequestHandlerAsync : bh:BeginEventHandler * eh:EndEventHandler -> unit + 1 overload
  member AddOnPostAcquireRequestStateAsync : bh:BeginEventHandler * eh:EndEventHandler -> unit + 1 overload
  member AddOnPostAuthenticateRequestAsync : bh:BeginEventHandler * eh:EndEventHandler -> unit + 1 overload
  ...

Full name: System.Web.HttpApplication

--------------------
Web.HttpApplication() : unit

More information

Link:http://fssnip.net/2f
Posted:6 years ago
Author:Ryan Riley
Tags: async , wcf , wcf web api , web