Simple DTO passing in F# using Suave.

WebApp.fs

// Learn more about F# at http://fsharp.org
// See the 'F# Tutorial' project for more help.
open Suave
open Suave.Json
open Suave.Types
open Suave.Types.Methods
open Suave.Utils
open Suave.Http
open Suave.Http.Authentication
open Suave.Http.Writers
open Suave.Http.Applicatives
open Suave.Http.Successful
open Suave.Http.RequestErrors
open Suave.Web
open System
open System.Net.Http
open System.Text
open System.Runtime.Serialization

[<DataContract>]
type HelloResponse = 
  { [<field:DataMember(Name = "Greeting")>]
    Greeting : string }

[<DataContract>]
type PlusRequest = 
  { [<field:DataMember(Name = "A")>]
    A : int
    [<field:DataMember(Name = "B")>]
    B : int }

/// Checks whether header is present in the context c.
let has_header (header : string * string) (c : HttpContext) = 
  async.Return <| match c.request.headers %% fst header with
                  | Some v when v = snd header -> Some c
                  | _ -> None

/// Converts an object to JSON and passes it to a HTTP response such as OK, anything
/// that accepts a string. 
let write_json (status : string -> WebPart) dto : WebPart = 
  set_header "Content-Type" "application/json" >>= status (ASCII.to_string' <| to_json dto)

/// Reads a JSON blob that is expected to be of type 'a, passes it to builder that returns an object
/// of type 'b, and converts 'b to JSON, and passes it to a HTTP response method (such as OK). 
let build_json (status : string -> WebPart) (builder : 'a -> 'b) = 
  request (fun r -> 
    has_header ("Content-Type", "application/json") >>= (from_json<'a> r.raw_form
                                                         |> builder
                                                         |> write_json status))

let greet_plus_with_hello = 
  build_json OK (fun (p : PlusRequest) -> { Greeting = sprintf "Hello %d!" (p.A + p.B) })

let app = 
  choose [ POST >>= url "/blah" >>= greet_plus_with_hello
           authenticate_basic (fun (u, p) -> u = "perkele" && p = "helvetti")
           POST >>= url "/ding" >>= write_json OK { Greeting = "Hello protected user!" }
           NOT_FOUND "Not found" ]

[<EntryPoint>]
let main argv = 
  web_server default_config app
  0 // return an integer exit code

Hienot stringit