adds login request validation

Author: demystifyfp

src/FsTweet.Web/Auth.fs

@@ -1,9 +1,33 @@
 namespace Auth
 
+module Domain = 
+  open User
+  open Chessie.ErrorHandling
+
+  type LoginRequest = {
+    Username : Username
+    Password : Password
+  }
+  with static member TryCreate (username, password) = 
+        trial {
+          let! username = Username.TryCreate username
+          let! password = Password.TryCreate password
+          return {
+            Username = username
+            Password = password
+          }
+        }
+
+
 module Suave =
+  open Suave
   open Suave.Filters
   open Suave.Operators
   open Suave.DotLiquid
+  open Suave.Form
+  open Domain
+  open Chessie.ErrorHandling
+  open Chessie
 
   type LoginViewModel = {
     Username : string
@@ -17,7 +41,28 @@ module Suave =
     Error = None
   }
 
+  let handleUserLogin ctx = async {
+    match bindEmptyForm ctx.request with
+    | Choice1Of2 (vm : LoginViewModel) ->
+      let result = 
+        LoginRequest.TryCreate (vm.Username, vm.Password)
+      match result with
+      | Success req -> 
+        return! Successful.OK "TODO" ctx
+      | Failure err -> 
+        let viewModel =
+          {vm with Error = Some err}
+        return! page "guest/login.liquid" viewModel ctx
+    | Choice2Of2 err ->
+      let viewModel = 
+        {emptyLoginViewModel with Error = Some err}
+      return! page "guest/login.liquid" viewModel ctx
+  }
+
   let renderLoginPage viewModel = 
     page "guest/login.liquid" viewModel
   let webpart () =
-    path "/login" >=> renderLoginPage emptyLoginViewModel
+    path "/login" >=> choose [
+      GET >=> renderLoginPage emptyLoginViewModel
+      POST >=> handleUserLogin
+    ]

src/FsTweet.Web/Chessie.fs

@@ -15,6 +15,11 @@ let onFailure f xs =
 let either onSuccessF onFailureF = 
   either (onSuccess onSuccessF) (onFailure onFailureF)
 
+let (|Success|Failure|) result = 
+  match result with
+  | Ok (x,_) -> Success x
+  | Bad errs -> Failure (List.head errs)
+
 [<RequireQualifiedAccess>]
 module AR =
   let mapFailure f aResult =

src/FsTweet.Web/User.fs

@@ -49,4 +49,4 @@ type PasswordHash = private PasswordHash of string with
 
   static member Create (password : Password) =
     BCrypt.HashPassword(password.Value)
-    |> PasswordHash
+    |> PasswordHash 

src/FsTweet.Web/views/user/signup.liquid

@@ -9,7 +9,7 @@
   <form class="form-signup" method="POST" action="/signup">
     <h2 class="form-signup-heading">Join FsTweet Today!</h2>
     {% if model.Error %}
-      <p class="bg-danger">
+      <p class="alert alert-danger">
         {{ model.Error.Value }}
       </p>
     {% endif %}