Example of generated server code

SpecWithParametersAndRequestBodySchemas.fs

[<RequireQualifiedAccess>]
module SpecwithparametersandrequestbodyAPI

open System.ComponentModel.DataAnnotations
open FSharp.Control.Tasks.V2.ContextInsensitive
open Giraffe
open System.Threading.Tasks
open Microsoft.AspNetCore.Http
open Microsoft.Extensions.DependencyInjection

///<summary>replaces any generated validation rules for type</summary>
[<Interface>]
type 'model IGiraffeValidator =
    abstract Validate: ('model * ValidationContext) -> ValidationResult array

///<summary>replaces any generated validation rules for type</summary>
and [<Interface>] 'model IGiraffeAdditionalValidator =
    abstract Validate: ('model * ValidationContext) -> ValidationResult array

[<CLIMutable>]
type forDefaultsTesting =
    { optionalArrayWithDefaultItems: int array option
      [<Required>]
      requiredArrayWithDefaultItems: int array
      [<Required>]
      apiKey: string
      [<Required>]
      apiVersionNumber: string
      [<Required>]
      apiUrl: System.Uri
      [<Required>]
      apiCount: int64
      [<Required>]
      apiAvg: int
      [<Required>]
      isInternal: bool
      [<Required>]
      start: System.DateTime
      [<Required>]
      someDateTime: System.DateTimeOffset
      [<Required>]
      pi: double
      [<Required>]
      someUid: System.Guid }

and [<CLIMutable>] dataSetListInput =
    { total: int option
      [<Required>]
      defaultsTest: forDefaultsTesting }

and [<CLIMutable>] dataSetListOutput =
    { [<Required>]
      pathParam: string
      queryParam: int option
      total: int option
      [<Required>]
      defaultsTest: forDefaultsTesting }

and [<CLIMutable>] forDefaultsTestingForBinding =
    { optionalArrayWithDefaultItems: int option array option
      [<Required>]
      requiredArrayWithDefaultItems: int option array
      apiKey: string option
      apiVersionNumber: string option
      apiUrl: System.Uri option
      apiCount: int64 option
      apiAvg: int option
      isInternal: bool option
      start: System.DateTime option
      someDateTime: System.DateTimeOffset option
      pi: double option
      someUid: System.Guid option }

and [<CLIMutable>] dataSetListInputForBinding =
    { total: int option
      [<Required>]
      defaultsTest: forDefaultsTestingForBinding }

and [<CLIMutable>] PostPostIdPath =
    { [<Required>]
      param: string }

and [<CLIMutable>] PostPostIdQuery = { param: int option }

and [<CLIMutable>] PostIdPostInput =
    { [<Required>]
      paramFromPath: string
      paramFromQuery: int option }

///<summary>
///Input binding error
///</summary>
and ArgumentError =
    ///<summary>
    ///Bound argument is not valid
    ///</summary>
    | ArgumentValidationError of ValidationResult array
    ///<summary>
    ///Giraffe returned a Result.Error from tryBindXXX
    ///</summary>
    | GiraffeBindingError of string
    ///<summary>
    ///Exception occurred during IFormatter bind
    ///</summary>
    | FormatterBindingException of exn
    ///<summary>
    ///Multiple errors occurred in one location
    ///</summary>
    | CombinedArgumentErrors of ArgumentError array

///<summary>
///Location argument error
///</summary>
and ArgumentLocationedError =
    ///<summary>
    ///Body error
    ///</summary>
    | BodyBindingError of ArgumentError
    ///<summary>
    ///Query error
    ///</summary>
    | QueryBindingError of ArgumentError
    ///<summary>
    ///Path error
    ///</summary>
    | PathBindingError of ArgumentError
    ///<summary>
    ///Multiple locations errors
    ///</summary>
    | CombinedArgumentLocationError of ArgumentLocationedError array

let rec argErrorToString level value =
    let sep = System.String(' ', level * 2)
    match value with
    | GiraffeBindingError err -> sprintf "%sGiraffe binding error: %s" sep err
    | FormatterBindingException err -> err.Message
    | CombinedArgumentErrors err ->
        sprintf "%sMultiple errors:\n%s" sep (String.concat "\n" (Seq.map (argErrorToString (level + 1)) err))
    | ArgumentValidationError err ->
        let errStrings =
            Option.ofObj err
            |> Option.defaultValue Array.empty
            |> Array.map (fun v ->
                let path =
                    Option.ofObj v.MemberNames |> Option.map (String.concat ".")

                let error = Option.ofObj v.ErrorMessage
                Option.map2 (sprintf "%s (at %s)") error path
                |> Option.orElse error
                |> Option.orElse path
                |> Option.defaultValue "unknown validation error")

        if errStrings |> Array.length = 0 then
            sprintf "%sUnknown validation error" sep
        else if errStrings |> Array.length = 1 then
            errStrings
            |> Array.head
            |> sprintf "%sValidation error: %s" sep
        else
            let sepInner = sprintf "\n%s " sep
            errStrings
            |> String.concat sepInner
            |> sprintf "%sValidation errors:%s%s" sep sepInner

let rec argLocationErrorToString level value =
    let sep = System.String(' ', level * 2)
    match value with
    | BodyBindingError body -> sprintf "%sBody binding error:\n%s" sep (argErrorToString (level + 1) body)
    | PathBindingError path -> sprintf "%sPath binding error:\n%s" sep (argErrorToString (level + 1) path)
    | QueryBindingError query -> sprintf "%sQuery binding error:\n%s" sep (argErrorToString (level + 1) query)
    | CombinedArgumentLocationError err ->
        sprintf
            "%sMultiple binding errors:\n%s"
            sep
            (String.concat "\n\n" (Seq.map (argLocationErrorToString (level + 1)) err))

let tryExtractError value =
    match value with
    | Ok _ -> None
    | Error err -> Some err

let isObjectValid boxed errors validationContext =
    Validator.TryValidateObject(boxed, validationContext, errors, true)

let isValueValid validationAttributes boxed errors validationContext =
    Validator.TryValidateValue(boxed, validationContext, errors, validationAttributes)

let validateInner isValid (ctx: HttpContext) validationContext (value: 'model) =
    let customValidator =
        ctx.RequestServices.GetService<IGiraffeValidator<'model>>()

    let errs =
        if System.Object.ReferenceEquals(customValidator, null) then
            let errs = System.Collections.Generic.List()
            if isValid value errs validationContext then Array.empty else errs |> Seq.toArray
        else
            customValidator.Validate(value, validationContext)

    let errs =
        let customAugmentingValidator =
            ctx.RequestServices.GetService<IGiraffeAdditionalValidator<'model>>()

        if System.Object.ReferenceEquals(customAugmentingValidator, null) then
            errs
        else
            customAugmentingValidator.Validate(value, validationContext)
            |> Array.append errs

    errs

let withValue (validationContext: ValidationContext) value =
    let ctx =
        ValidationContext(value, validationContext.Items)

    ctx.InitializeServiceProvider(fun t -> validationContext.GetService t)
    ctx.MemberName <- null
    ctx


let withMemberAndValue (validationContext: ValidationContext) name value =
    let ctx = withValue validationContext value
    ctx.MemberName <- name
    ctx


let rec validate ctx (validationContext: ValidationContext) =
    let instance = validationContext.ObjectInstance
    [| match instance with
       | :? dataSetListInput as value ->
           yield! validateInner isObjectValid ctx validationContext value

           let validationContext =
               withMemberAndValue validationContext "defaultsTest" value.defaultsTest

           yield! validate ctx validationContext

       | :? forDefaultsTesting as value -> yield! validateInner isObjectValid ctx validationContext value
       | :? PostPostIdPath as value -> yield! validateInner isObjectValid ctx validationContext value
       | :? PostPostIdQuery as value -> yield! validateInner isObjectValid ctx validationContext value
       | v -> failwithf "Unknown type came to validation: %A" (v.GetType()) |]

let bindValidation (ctx: HttpContext) location (value: 'model) =
    let validationContext =
        ValidationContext(value, ctx.RequestServices, ctx.Items)

    let errs = validate ctx validationContext
    if (errs |> Array.length) = 0 then
        Ok value
    else
        errs
        |> ArgumentValidationError
        |> location
        |> Error

[<AbstractClass>]
type Service() =
    abstract PostId: PostPostIdPath -> HttpHandler

    override this.PostId pathArgs =
        fun next ctx ->
            task {
                let queryArgs =
                    ctx.TryBindQueryString<PostPostIdQuery> System.Globalization.CultureInfo.InvariantCulture
                    |> Result.mapError (GiraffeBindingError >> QueryBindingError)
                    |> Result.bind (bindValidation ctx QueryBindingError)

                let pathArgs =
                    Result<PostPostIdPath, ArgumentLocationedError>.Ok pathArgs
                    |> Result.bind (bindValidation ctx PathBindingError)

                let combinedArgs =
                    pathArgs
                    |> Result.bind (fun pathArgs ->
                        queryArgs
                        |> Result.map (fun queryArgs ->
                            let v: PostIdPostInput =
                                { paramFromPath = pathArgs.param
                                  paramFromQuery = queryArgs.param }

                            v))

                let! bodyArgs =
                    task {
                        try
                            let! bodyArgs = ctx.BindJsonAsync<dataSetListInputForBinding>()
                            return Ok bodyArgs
                            |> Result.map (fun (src: dataSetListInputForBinding) ->
                                let v: dataSetListInput =
                                    { total = src.total
                                      defaultsTest =
                                          { optionalArrayWithDefaultItems =
                                                src.defaultsTest.optionalArrayWithDefaultItems
                                                |> Option.map (fun (src: int option array) ->
                                                    src
                                                    |> Array.map (fun (src: int option) ->
                                                        src |> Option.defaultValue (42)))
                                            requiredArrayWithDefaultItems =
                                                src.defaultsTest.requiredArrayWithDefaultItems
                                                |> Array.map (fun (src: int option) -> src |> Option.defaultValue (48))
                                            apiKey =
                                                src.defaultsTest.apiKey
                                                |> Option.defaultValue ("pa$$word")
                                            apiVersionNumber =
                                                src.defaultsTest.apiVersionNumber
                                                |> Option.defaultValue ("1")
                                            apiUrl =
                                                src.defaultsTest.apiUrl
                                                |> Option.defaultValue (System.Uri "http://localhost:8080/api")
                                            apiCount =
                                                src.defaultsTest.apiCount
                                                |> Option.defaultValue (123456789123456L)
                                            apiAvg =
                                                src.defaultsTest.apiAvg
                                                |> Option.defaultValue (1234567890)
                                            isInternal =
                                                src.defaultsTest.isInternal
                                                |> Option.defaultValue (true)
                                            start =
                                                src.defaultsTest.start
                                                |> Option.defaultValue (System.DateTime(2020, 10, 8))
                                            someDateTime =
                                                src.defaultsTest.someDateTime
                                                |> Option.defaultValue
                                                    (System.DateTimeOffset
                                                        ((637377153000000000L),
                                                         System.TimeSpan.FromTicks((108000000000L))))
                                            pi = src.defaultsTest.pi |> Option.defaultValue (3.14)
                                            someUid =
                                                src.defaultsTest.someUid
                                                |> Option.defaultValue
                                                    (System.Guid.ParseExact("8282cbfd-f323-4b7d-bcc0-28f127c2b365", "D")) } }

                                v)
                            |> Result.bind (bindValidation ctx BodyBindingError)
                        with e ->
                            return FormatterBindingException e
                            |> BodyBindingError
                            |> Error
                    }

                let args =
                    combinedArgs
                    |> Result.bind (fun combinedArgs ->
                        bodyArgs
                        |> Result.map (fun bodyArgs -> (combinedArgs, bodyArgs)))

                let args =
                    match args with
                    | Ok v -> Ok v
                    | Error e ->
                        let errs =
                            [ tryExtractError pathArgs
                              tryExtractError queryArgs
                              tryExtractError bodyArgs ]
                            |> Seq.choose id
                            |> Seq.toArray

                        (if errs.Length > 1 then CombinedArgumentLocationError errs else Array.head errs)
                        |> Error

                let! logicOutput =
                    match args with
                    | Ok (combinedArgs, bodyArgs) -> this.PostIdInput(combinedArgs, bodyArgs, ctx)
                    | Error e -> this.PostIdInputError(e, ctx)

                return! this.PostIdOutput logicOutput next ctx
            }

    abstract PostIdInput: (PostIdPostInput * dataSetListInput * HttpContext) -> Task<dataSetListOutput>
    abstract PostIdInputError: (ArgumentLocationedError * HttpContext) -> Task<dataSetListOutput>

    override this.PostIdInputError t =
        let (err, http) = t
        let err = argLocationErrorToString 0 err
        Task.FromException<dataSetListOutput>(exn err)

    abstract PostIdOutput: dataSetListOutput -> HttpHandler
    override this.PostIdOutput input = json input

let webApp: HttpHandler =
    fun next ctx ->
        task {
            let service = ctx.GetService<Service>()
            return! (POST >=> routeBind "/id/{param}" service.PostId) next ctx
        }