Introduce Oxpecker.ModelValidation

examples/CRUD/Backend/Handlers.fs

@@ -27,8 +27,6 @@ type OperationEnv(env: Env) =
     interface IGetProducts with
         member this.GetProducts() = ProductRepository.getProducts env
 
-
-
 let getOrders env (ctx: HttpContext) =
     task {
         let operationEnv = OperationEnv(env)

examples/ContactApp/ContactApp.fsproj

@@ -17,6 +17,7 @@
         <Compile Include="Models.fs" />
         <Compile Include="Tools.fs" />
         <Compile Include="templates\shared\layout.fs" />
+        <Compile Include="templates\shared\errors.fs" />
         <Compile Include="templates\shared\contactFields.fs" />
         <Compile Include="templates\index.fs" />
         <Compile Include="templates\show.fs" />

examples/ContactApp/Handlers.fs

@@ -6,6 +6,7 @@ open ContactApp.Tools
 open Microsoft.AspNetCore.Http
 open Oxpecker
 open Oxpecker.Htmx
+open Oxpecker.ModelValidation
 
 let mutable archiver = Archiver(ResizeArray())
 
@@ -34,52 +35,56 @@ let getContactsCount: EndpointHandler =
         ctx.WriteText $"({count} total Contacts)"
 
 let getNewContact: EndpointHandler =
-    let newContact = {
-        id = 0
-        first = ""
-        last = ""
-        email = ""
-        phone = ""
-        errors = dict []
-    }
-    writeHtml (new'.html newContact)
+    writeHtml (new'.html ModelState.Empty)
 
 let insertContact: EndpointHandler =
     fun ctx ->
         task {
-            let! contact = ctx.BindForm<ContactDTO>()
-            let validatedContact = contact.Validate()
-            if validatedContact.errors.Count > 0 then
-                return! ctx |> writeHtml (new'.html validatedContact)
-            else
+            match! ctx.BindAndValidateForm<ContactDTO>() with
+            | ValidationResult.Valid validatedContact ->
                 validatedContact.ToDomain()
                 |> ContactService.add
                 |> ignore
                 flash "Created new Contact!" ctx
                 return ctx.Response.Redirect("/contacts")
+            | ValidationResult.Invalid invalidModel ->
+                return!
+                    invalidModel
+                    |> ModelState.Invalid
+                    |> new'.html
+                    |> writeHtml
+                    <| ctx
         }
 
 let updateContact id: EndpointHandler =
     fun ctx ->
         task {
-            let! contact = ctx.BindForm<ContactDTO>()
-            let validatedContact = contact.Validate()
-            if validatedContact.errors.Count > 0 then
-                return! ctx |> writeHtml (edit.html { validatedContact with id = id })
-            else
+            match! ctx.BindAndValidateForm<ContactDTO>() with
+            | ValidationResult.Valid validatedContact ->
                 let domainContact = validatedContact.ToDomain()
                 ContactService.update({domainContact with Id = id})
                 flash "Updated Contact!" ctx
                 return ctx.Response.Redirect($"/contacts/{id}")
+            | ValidationResult.Invalid (contactDto, errors) ->
+                return!
+                    ({ contactDto with id = id }, errors)
+                    |> ModelState.Invalid
+                    |> edit.html
+                    |> writeHtml
+                    <| ctx
         }
 
 let viewContact id: EndpointHandler =
     let contact = ContactService.find id
     writeHtml <| show.html contact
 
 let getEditContact id: EndpointHandler =
-    let contact = ContactService.find id |> ContactDTO.FromDomain
-    writeHtml <| edit.html contact
+    id
+    |> ContactService.find
+    |> ContactDTO.FromDomain
+    |> ModelState.Valid
+    |> edit.html
+    |> writeHtml
 
 let deleteContact id: EndpointHandler =
     fun ctx ->

examples/ContactApp/Models.fs

@@ -1,6 +1,5 @@
 module ContactApp.Models
-open System
-open System.Collections.Generic
+open System.ComponentModel.DataAnnotations
 
 
 type Contact = {
@@ -14,24 +13,17 @@ type Contact = {
 [<CLIMutable>]
 type ContactDTO = {
     id: int
+    [<Required>]
     first: string
+    [<Required>]
     last: string
+    [<Required>]
     phone: string
+    [<Required>]
+    [<EmailAddress>]
     email: string
-    errors: IDictionary<string, string>
 } with
-    member this.GetError key =
-        match this.errors.TryGetValue key with
-        | true, value -> value
-        | _ -> ""
-    member this.Validate() =
-        let errors = Dictionary<string, string>()
-        if String.IsNullOrEmpty(this.first) then errors.Add("first", "First name is required")
-        if String.IsNullOrEmpty(this.last) then errors.Add("last", "Last name is required")
-        if String.IsNullOrEmpty(this.phone) then errors.Add("phone", "Phone is required")
-        if String.IsNullOrEmpty(this.email) then errors.Add("email", "Email is required")
-        { this with errors = errors }
     member this.ToDomain() =
         { Id = this.id; First = this.first; Last = this.last; Phone = this.phone; Email = this.email }
     static member FromDomain(contact: Contact) =
-        { id = contact.Id; first = contact.First; last = contact.Last; phone = contact.Phone; email = contact.Email; errors = dict [] }
+        { id = contact.Id; first = contact.First; last = contact.Last; phone = contact.Phone; email = contact.Email }

examples/ContactApp/README.md

@@ -2,4 +2,6 @@
 
 Here you can find an F# version of the contact app presented in [Hypermedia Systems](https://hypermedia.systems/) book.
 
+It is also an example of `Oxpecker.ModelValidation` usage.
+
 ![image](https://github.com/Lanayx/Oxpecker/assets/3329606/888dc44f-3fa5-43e1-9da7-5df1d255b584)

examples/ContactApp/templates/edit.fs

@@ -1,13 +1,15 @@
 module ContactApp.templates.edit
 
+open Oxpecker.ModelValidation
 open Oxpecker.ViewEngine
 open Oxpecker.Htmx
 open ContactApp.Models
 open ContactApp.templates.shared
 
-let html (contact: ContactDTO) =
+let html (contact: ModelState<ContactDTO>) =
+    let contactId = contact.Value(_.id >> string)
     Fragment() {
-        form(action= $"/contacts/{contact.id}/edit", method="post") {
+        form(action= $"/contacts/{contactId}/edit", method="post") {
             fieldset() {
                 legend() { "Contact Values" }
                 contactFields.html contact
@@ -16,7 +18,7 @@ let html (contact: ContactDTO) =
         }
 
         button(id="delete-btn",
-               hxDelete= $"/contacts/{contact.id}",
+               hxDelete= $"/contacts/{contactId}",
                hxPushUrl="true",
                hxConfirm="Are you sure you want to delete this contact?",
                hxTarget="body") { "Delete Contact" }

examples/ContactApp/templates/new.fs

@@ -1,9 +1,10 @@
 module ContactApp.templates.new'
 open ContactApp.Models
+open Oxpecker.ModelValidation
 open Oxpecker.ViewEngine
 open ContactApp.templates.shared
 
-let html (contact: ContactDTO) =
+let html (contact: ModelState<ContactDTO>) =
     Fragment() {
         form(action="/contacts/new", method="post") {
             fieldset() {

examples/ContactApp/templates/shared/contactFields.fs

@@ -1,34 +1,38 @@
 namespace ContactApp.templates.shared
 
+open ContactApp.templates.shared.errors
 open Oxpecker.Htmx
+open Oxpecker.ModelValidation
 
 module contactFields =
 
     open ContactApp.Models
     open Oxpecker.ViewEngine
 
-    let html (contact: ContactDTO) =
+    let html (contact: ModelState<ContactDTO>) =
+        let x = Unchecked.defaultof<ContactDTO>
+        let showErrors = showErrors contact
         div() {
             p() {
                 label(for'="email") { "Email" }
-                input(name="email", id="email", type'="email", placeholder="Email", value=contact.email,
+                input(name=nameof x.email, id="email", type'="email", placeholder="Email", value=contact.Value(_.email),
                       hxTrigger="change, keyup delay:200ms changed",
-                      hxGet= $"/contacts/{contact.id}/email", hxTarget="next .error")
-                span(class'="error") { contact.GetError("email") }
+                      hxGet= $"/contacts/{contact.Value(_.id >> string)}/email", hxTarget="next .error")
+                showErrors <| nameof x.email
             }
             p() {
                 label(for'="first") { "First Name" }
-                input(name="first", id="firs", type'="text", placeholder="First Name", value=contact.first)
-                span(class'="error") { contact.GetError("first") }
+                input(name=nameof x.first, id="first", type'="text", placeholder="First Name", value=contact.Value(_.first))
+                showErrors <| nameof x.first
             }
             p() {
                 label(for'="last")  { "Last Name" }
-                input(name="last", id="last", type'="text", placeholder="Last Name", value=contact.last)
-                span(class'="error") { contact.GetError("last") }
+                input(name=nameof x.last, id="last", type'="text", placeholder="Last Name", value=contact.Value(_.last))
+                showErrors <| nameof x.last
             }
             p() {
                 label(for'="phone") { "Phone" }
-                input(name="phone", id="phone", type'="text", placeholder="Phone", value=contact.phone)
-                span(class'="error") { contact.GetError("phone") }
+                input(name=nameof x.phone, id="phone", type'="text", placeholder="Phone", value=contact.Value(_.phone))
+                showErrors <| nameof x.phone
             }
         }

examples/ContactApp/templates/shared/errors.fs

@@ -0,0 +1,13 @@
+module ContactApp.templates.shared.errors
+
+open Oxpecker.ViewEngine
+open Oxpecker.ModelValidation
+
+let showErrors (modelState: ModelState<_>) (fieldName: string) =
+    match modelState with
+    | ModelState.Invalid (_, modelErrors) ->
+        span(class'="error"){
+            modelErrors.ErrorMessagesFor(fieldName) |> String.concat ", "
+        } :> HtmlElement
+    | _ ->
+        Fragment()

src/Oxpecker/ModelValidation.fs

@@ -0,0 +1,138 @@
+namespace Oxpecker
+
+[<AutoOpen>]
+module ModelValidation =
+
+    open System.Collections.Generic
+    open System.ComponentModel.DataAnnotations
+    open System.Runtime.CompilerServices
+    open Microsoft.AspNetCore.Http
+
+    type ValidationErrors (errors: ResizeArray<ValidationResult>) =
+        let errorDict = lazy (
+            let dict = Dictionary<string,ResizeArray<string>>()
+            for error in errors do
+                for memberName in error.MemberNames do
+                    match dict.TryGetValue(memberName) with
+                    | true, value ->
+                        value.Add(error.ErrorMessage)
+                    | false, _ ->
+                        let arrayList = ResizeArray(1)
+                        arrayList.Add(error.ErrorMessage)
+                        dict[memberName] <- arrayList
+            dict
+        )
+        member this.All: ValidationResult seq = errors
+        member this.ErrorMessagesFor(name): string seq =
+            match errorDict.Value.TryGetValue(name) with
+            | true, value -> value
+            | false, _ -> Seq.empty
+
+    type InvalidModel<'T> = 'T * ValidationErrors
+
+    [<RequireQualifiedAccess>]
+    type ModelState<'T> =
+        | Empty
+        | Valid of 'T
+        | Invalid of InvalidModel<'T>
+        member this.Value(f: 'T -> string|null) =
+            match this with
+            | Empty -> null
+            | Valid model -> f model |> string
+            | Invalid (model, _) -> f model |> string
+        member this.BoolValue(f: 'T -> bool) =
+            match this with
+            | Empty -> false
+            | Valid model -> f model
+            | Invalid (model, _) -> f model
+
+    [<RequireQualifiedAccess>]
+    type ValidationResult<'T> =
+        | Valid of 'T
+        | Invalid of InvalidModel<'T>
+
+    let validateModel (model: 'T) =
+        let validationResults = ResizeArray()
+        match Validator.TryValidateObject(model, ValidationContext(model), validationResults, true) with
+        | true -> ValidationResult.Valid model
+        | false -> ValidationResult.Invalid (model, ValidationErrors(validationResults))
+
+    type HttpContextExtensions =
+
+        /// <summary>
+        /// Uses the <see cref="Serializers.IJsonSerializer"/> to deserialize the entire body of the <see cref="Microsoft.AspNetCore.Http.HttpRequest"/> asynchronously into an object of type 'T and then validate it.
+        /// </summary>
+        /// <typeparam name="'T"></typeparam>
+        /// <returns>Returns a <see cref="System.Threading.Tasks.Task{T}"/></returns>
+        [<Extension>]
+        static member BindAndValidateJson<'T>(ctx: HttpContext) =
+            task {
+                let! result = ctx.BindJson<'T>()
+                return validateModel result
+            }
+
+        /// <summary>
+        /// Parses all input elements from an HTML form into an object of type 'T and then validates it.
+        /// </summary>
+        /// <param name="ctx">The current http context object.</param>
+        /// <typeparam name="'T"></typeparam>
+        /// <returns>Returns a <see cref="System.Threading.Tasks.Task{T}"/></returns>
+        [<Extension>]
+        static member BindAndValidateForm<'T>(ctx: HttpContext) =
+            task {
+                let! result = ctx.BindForm<'T>()
+                return validateModel result
+            }
+
+        /// <summary>
+        /// Parses all parameters of a request's query string into an object of type 'T and then validates it.
+        /// </summary>
+        /// <param name="ctx">The current http context object.</param>
+        /// <typeparam name="'T"></typeparam>
+        /// <returns>Returns an instance of type 'T</returns>
+        [<Extension>]
+        static member BindAndValidateQuery<'T>(ctx: HttpContext) =
+            let result = ctx.BindQuery<'T>()
+            validateModel result
+
+    [<AutoOpen>]
+    module RequestHandlers =
+        /// <summary>
+        /// Parses a JSON payload into an instance of type 'T and validates it.
+        /// </summary>
+        /// <param name="f">A function which accepts an object of type ValidationResult<'T> and returns a <see cref="EndpointHandler"/> function.</param>
+        /// <param name="ctx">HttpContext</param>
+        /// <typeparam name="'T"></typeparam>
+        /// <returns>An Oxpecker <see cref="EndpointHandler"/> function which can be composed into a bigger web application.</returns>
+        let bindAndValidateJson<'T> (f: ValidationResult<'T> -> EndpointHandler) : EndpointHandler =
+            fun (ctx: HttpContext) ->
+                task {
+                    let! model = ctx.BindJson<'T>()
+                    return! f (validateModel model) ctx
+                }
+
+        /// <summary>
+        /// Parses a HTTP form payload into an instance of type 'T and validates it.
+        /// </summary>
+        /// <param name="f">A function which accepts an object of type 'T and returns a <see cref="EndpointHandler"/> function.</param>
+        /// <param name="ctx">HttpContext</param>
+        /// <typeparam name="'T"></typeparam>
+        /// <returns>An Oxpecker <see cref="EndpointHandler"/> function which can be composed into a bigger web application.</returns>
+        let bindAndValidateForm<'T> (f: ValidationResult<'T> -> EndpointHandler) : EndpointHandler =
+            fun (ctx: HttpContext) ->
+                task {
+                    let! model = ctx.BindForm<'T>()
+                    return! f (validateModel model) ctx
+                }
+
+        /// <summary>
+        /// Parses a HTTP query string into an instance of type 'T and validates it.
+        /// </summary>
+        /// <param name="f">A function which accepts an object of type 'T and returns a <see cref="EndpointHandler"/> function.</param>
+        /// <param name="ctx">HttpContext</param>
+        /// <typeparam name="'T"></typeparam>
+        /// <returns>An Oxpecker <see cref="EndpointHandler"/> function which can be composed into a bigger web application.</returns>
+        let bindAndValidateQuery<'T> (f: ValidationResult<'T> -> EndpointHandler) : EndpointHandler =
+            fun (ctx: HttpContext) ->
+                let model = ctx.BindQuery<'T>()
+                f (validateModel model) ctx

src/Oxpecker/Oxpecker.fsproj

@@ -44,6 +44,7 @@
         <Compile Include="DateTimeExtensions.fs" />
         <Compile Include="Core.fs" />
         <Compile Include="Handlers.fs" />
+        <Compile Include="ModelValidation.fs" />
         <Compile Include="ResponseCaching.fs" />
         <Compile Include="Preconditional.fs" />
         <Compile Include="Streaming.fs" />