adds login user domain type

Author: demystifyfp

script.fsx

@@ -1,8 +1,7 @@
 #r "./packages/email/Newtonsoft.Json/lib/net45/Newtonsoft.Json.dll"
-open Newtonsoft.Json
+#r "./packages/BCrypt.Net-Next/lib/net452/BCrypt.Net-Next.dll"
 
-let placeHolders = 
-  Map.empty
-    .Add("verification_code", "12323")
+open BCrypt.Net
 
-JsonConvert.SerializeObject(placeHolders)
+
+BCrypt.InterrogateHash "$2a$10$e8IgrOqZx08UTwIZSbswAec7ospkD.E/JeySAWj19iDcksRDWE9y6"

src/FsTweet.Web/Auth.fs

@@ -18,6 +18,13 @@ module Domain =
           }
         }
 
+  type LoginError =
+  | UsernameNotFound
+  | EmailNotVerified
+  | PasswordMisMatch
+  | Error of System.Exception
+
+  type Login = FindUser -> LoginRequest -> AsyncResult<User, LoginError>
 
 module Suave =
   open Suave
@@ -50,8 +57,7 @@ module Suave =
       | Success req -> 
         return! Successful.OK "TODO" ctx
       | Failure err -> 
-        let viewModel =
-          {vm with Error = Some err}
+        let viewModel = {vm with Error = Some err}
         return! page "guest/login.liquid" viewModel ctx
     | Choice2Of2 err ->
       let viewModel = 

src/FsTweet.Web/FsTweet.Web.fsproj

@@ -41,9 +41,9 @@
   </ItemGroup>
   <ItemGroup>
     <Compile Include="Chessie.fs" />
-    <Compile Include="User.fs" />
     <Compile Include="Db.fs" />
     <Compile Include="Email.fs" />
+    <Compile Include="User.fs" />
     <Compile Include="UserSignup.fs" />
     <Compile Include="Auth.fs" />
     <Compile Include="FsTweet.Web.fs" />

src/FsTweet.Web/User.fs

@@ -49,4 +49,22 @@ type PasswordHash = private PasswordHash of string with
 
   static member Create (password : Password) =
     BCrypt.HashPassword(password.Value)
-    |> PasswordHash 
+    |> PasswordHash 
+
+type UserEmail = 
+| Verified of EmailAddress
+| NotVerified of EmailAddress
+
+type User = {
+  UserId : UserId
+  Username : Username
+  Email : UserEmail
+  PasswordHash : PasswordHash
+}
+
+type FindUser = Username -> AsyncResult<User option, System.Exception>
+
+
+module Persistence =
+  open Database
+  let findUser (getDataCtx : GetDataContext) (username : Username) = ()

src/FsTweet.Web/UserSignup.fs

@@ -118,7 +118,8 @@ module Persistence =
       UsernameAlreadyExists
     | _ -> Error ex
 
-  let createUser (getDataCtx : GetDataContext) createUserReq = asyncTrial {
+  let createUser (getDataCtx : GetDataContext) 
+    (createUserReq : CreateUserRequest) = asyncTrial {
     let ctx = getDataCtx ()
     let users = ctx.Public.Users
 
@@ -252,13 +253,13 @@ module Suave =
       let result =
         UserSignupRequest.TryCreate (vm.Username, vm.Password, vm.Email)
       match result with
-      | Ok (userSignupReq, _) ->
+      | Success userSignupReq ->
         let userSignupAsyncResult = signupUser userSignupReq
         let! webpart =
           handleUserSignupAsyncResult vm userSignupAsyncResult
         return! webpart ctx
-      | Bad msgs ->
-        let viewModel = {vm with Error = Some (List.head msgs)}
+      | Failure msg ->
+        let viewModel = {vm with Error = Some msg}
         return! page signupTemplatePath viewModel ctx
     | Choice2Of2 err ->
       let viewModel = {emptyUserSignupViewModel with Error = Some err}