v2 RC2 (#33)

* Add PostgreSQL back end (#30)
* Upgrade password storage (#32)
* Change podcast/episode storage for SQLite (#29)
* Move date/time handling to NodaTime (#31)

src/MyWebLog.Data/Postgres/PostgresWebLogUserData.fs

@@ -0,0 +1,149 @@
+namespace MyWebLog.Data.Postgres
+
+open MyWebLog
+open MyWebLog.Data
+open Npgsql
+open Npgsql.FSharp
+
+/// PostgreSQL myWebLog user data implementation        
+type PostgresWebLogUserData (conn : NpgsqlConnection) =
+    
+    /// The INSERT statement for a user
+    let userInsert =
+        "INSERT INTO web_log_user (
+            id, web_log_id, email, first_name, last_name, preferred_name, password_hash, url, access_level,
+            created_on, last_seen_on
+        ) VALUES (
+            @id, @webLogId, @email, @firstName, @lastName, @preferredName, @passwordHash, @url, @accessLevel,
+            @createdOn, @lastSeenOn
+        )"
+    
+    /// Parameters for saving web log users
+    let userParams (user : WebLogUser) = [
+        "@id",            Sql.string       (WebLogUserId.toString user.Id)
+        "@webLogId",      Sql.string       (WebLogId.toString user.WebLogId)
+        "@email",         Sql.string       user.Email
+        "@firstName",     Sql.string       user.FirstName
+        "@lastName",      Sql.string       user.LastName
+        "@preferredName", Sql.string       user.PreferredName
+        "@passwordHash",  Sql.string       user.PasswordHash
+        "@url",           Sql.stringOrNone user.Url
+        "@accessLevel",   Sql.string       (AccessLevel.toString user.AccessLevel)
+        typedParam "createdOn"  user.CreatedOn
+        optParam   "lastSeenOn" user.LastSeenOn
+    ]
+
+    /// Find a user by their ID for the given web log
+    let findById userId webLogId =
+        Sql.existingConnection conn
+        |> Sql.query "SELECT * FROM web_log_user WHERE id = @id AND web_log_id = @webLogId"
+        |> Sql.parameters [ "@id", Sql.string (WebLogUserId.toString userId); webLogIdParam webLogId ]
+        |> Sql.executeAsync Map.toWebLogUser
+        |> tryHead
+    
+    /// Delete a user if they have no posts or pages
+    let delete userId webLogId = backgroundTask {
+        match! findById userId webLogId with
+        | Some _ ->
+            let userParam = [ "@userId", Sql.string (WebLogUserId.toString userId) ]
+            let! isAuthor =
+                Sql.existingConnection conn
+                |> Sql.query
+                    "SELECT (   EXISTS (SELECT 1 FROM page WHERE author_id = @userId
+                             OR EXISTS (SELECT 1 FROM post WHERE author_id = @userId)) AS does_exist"
+                |> Sql.parameters userParam
+                |> Sql.executeRowAsync Map.toExists
+            if isAuthor then
+                return Error "User has pages or posts; cannot delete"
+            else
+                let! _ =
+                    Sql.existingConnection conn
+                    |> Sql.query "DELETE FROM web_log_user WHERE id = @userId"
+                    |> Sql.parameters userParam
+                    |> Sql.executeNonQueryAsync
+                return Ok true
+        | None -> return Error "User does not exist"
+    }
+    
+    /// Find a user by their e-mail address for the given web log
+    let findByEmail email webLogId =
+        Sql.existingConnection conn
+        |> Sql.query "SELECT * FROM web_log_user WHERE web_log_id = @webLogId AND email = @email"
+        |> Sql.parameters [ webLogIdParam webLogId; "@email", Sql.string email ]
+        |> Sql.executeAsync Map.toWebLogUser
+        |> tryHead
+    
+    /// Get all users for the given web log
+    let findByWebLog webLogId =
+        Sql.existingConnection conn
+        |> Sql.query "SELECT * FROM web_log_user WHERE web_log_id = @webLogId ORDER BY LOWER(preferred_name)"
+        |> Sql.parameters [ webLogIdParam webLogId ]
+        |> Sql.executeAsync Map.toWebLogUser
+    
+    /// Find the names of users by their IDs for the given web log
+    let findNames webLogId userIds = backgroundTask {
+        let idSql, idParams = inClause "AND id" "id" WebLogUserId.toString userIds
+        let! users =
+            Sql.existingConnection conn
+            |> Sql.query $"SELECT * FROM web_log_user WHERE web_log_id = @webLogId {idSql}"
+            |> Sql.parameters (webLogIdParam webLogId :: idParams)
+            |> Sql.executeAsync Map.toWebLogUser
+        return
+            users
+            |> List.map (fun u -> { Name = WebLogUserId.toString u.Id; Value = WebLogUser.displayName u })
+    }
+    
+    /// Restore users from a backup
+    let restore users = backgroundTask {
+        let! _ =
+            Sql.existingConnection conn
+            |> Sql.executeTransactionAsync [
+                userInsert, users |> List.map userParams
+            ]
+        ()
+    }
+    
+    /// Set a user's last seen date/time to now
+    let setLastSeen userId webLogId = backgroundTask {
+        let! _ =
+            Sql.existingConnection conn
+            |> Sql.query "UPDATE web_log_user SET last_seen_on = @lastSeenOn WHERE id = @id AND web_log_id = @webLogId"
+            |> Sql.parameters
+                [   webLogIdParam webLogId
+                    typedParam "lastSeenOn" (Noda.now ())
+                    "@id", Sql.string (WebLogUserId.toString userId) ]
+            |> Sql.executeNonQueryAsync
+        ()
+    }
+    
+    /// Save a user
+    let save user = backgroundTask {
+        let! _ =
+            Sql.existingConnection conn
+            |> Sql.query $"
+                {userInsert} ON CONFLICT (id) DO UPDATE
+                SET email          = @email,
+                    first_name     = @firstName,
+                    last_name      = @lastName,
+                    preferred_name = @preferredName,
+                    password_hash  = @passwordHash,
+                    url            = @url,
+                    access_level   = @accessLevel,
+                    created_on     = @createdOn,
+                    last_seen_on   = @lastSeenOn"
+            |> Sql.parameters (userParams user)
+            |> Sql.executeNonQueryAsync
+        ()
+    }
+    
+    interface IWebLogUserData with
+        member _.Add user = save user
+        member _.Delete userId webLogId = delete userId webLogId
+        member _.FindByEmail email webLogId = findByEmail email webLogId
+        member _.FindById userId webLogId = findById userId webLogId
+        member _.FindByWebLog webLogId = findByWebLog webLogId
+        member _.FindNames webLogId userIds = findNames webLogId userIds
+        member _.Restore users = restore users
+        member _.SetLastSeen userId webLogId = setLastSeen userId webLogId
+        member _.Update user = save user
+