diff --git a/src/MyWebLog.Data/SQLite/Helpers.fs b/src/MyWebLog.Data/SQLite/Helpers.fs index 22c5b77..a7a6fd6 100644 --- a/src/MyWebLog.Data/SQLite/Helpers.fs +++ b/src/MyWebLog.Data/SQLite/Helpers.fs @@ -291,16 +291,16 @@ module Map = /// Create a web log user from the current row in the given data reader let toWebLogUser (rdr : SqliteDataReader) : WebLogUser = - { id = WebLogUserId (getString "id" rdr) - webLogId = WebLogId (getString "web_log_id" rdr) - userName = getString "user_name" rdr - firstName = getString "first_name" rdr - lastName = getString "last_name" rdr - preferredName = getString "preferred_name" rdr - passwordHash = getString "password_hash" rdr - salt = getGuid "salt" rdr - url = tryString "url" rdr - authorizationLevel = AuthorizationLevel.parse (getString "authorization_level" rdr) + { id = WebLogUserId (getString "id" rdr) + webLogId = WebLogId (getString "web_log_id" rdr) + userName = getString "user_name" rdr + firstName = getString "first_name" rdr + lastName = getString "last_name" rdr + preferredName = getString "preferred_name" rdr + passwordHash = getString "password_hash" rdr + salt = getGuid "salt" rdr + url = tryString "url" rdr + accessLevel = AccessLevel.parse (getString "access_level" rdr) } /// Add a possibly-missing parameter, substituting null for None diff --git a/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs b/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs index 019779f..d448f5b 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs @@ -20,7 +20,7 @@ type SQLiteWebLogUserData (conn : SqliteConnection) = cmd.Parameters.AddWithValue ("@passwordHash", user.passwordHash) cmd.Parameters.AddWithValue ("@salt", user.salt) cmd.Parameters.AddWithValue ("@url", maybe user.url) - cmd.Parameters.AddWithValue ("@authorizationLevel", AuthorizationLevel.toString user.authorizationLevel) + cmd.Parameters.AddWithValue ("@accessLevel", AccessLevel.toString user.accessLevel) ] |> ignore // IMPLEMENTATION FUNCTIONS @@ -31,10 +31,10 @@ type SQLiteWebLogUserData (conn : SqliteConnection) = cmd.CommandText <- """ INSERT INTO web_log_user ( id, web_log_id, user_name, first_name, last_name, preferred_name, password_hash, salt, url, - authorization_level + access_level ) VALUES ( @id, @webLogId, @userName, @firstName, @lastName, @preferredName, @passwordHash, @salt, @url, - @authorizationLevel + @accessLevel )""" addWebLogUserParameters cmd user do! write cmd @@ -96,14 +96,14 @@ type SQLiteWebLogUserData (conn : SqliteConnection) = use cmd = conn.CreateCommand () cmd.CommandText <- """ UPDATE web_log_user - SET user_name = @userName, - first_name = @firstName, - last_name = @lastName, - preferred_name = @preferredName, - password_hash = @passwordHash, - salt = @salt, - url = @url, - authorization_level = @authorizationLevel + SET user_name = @userName, + first_name = @firstName, + last_name = @lastName, + preferred_name = @preferredName, + password_hash = @passwordHash, + salt = @salt, + url = @url, + access_level = @accessLevel WHERE id = @id AND web_log_id = @webLogId""" addWebLogUserParameters cmd user diff --git a/src/MyWebLog.Data/SQLiteData.fs b/src/MyWebLog.Data/SQLiteData.fs index aaa79a2..f3e4885 100644 --- a/src/MyWebLog.Data/SQLiteData.fs +++ b/src/MyWebLog.Data/SQLiteData.fs @@ -165,16 +165,16 @@ type SQLiteData (conn : SqliteConnection, log : ILogger) = log.LogInformation "Creating web_log_user table..." cmd.CommandText <- """ CREATE TABLE web_log_user ( - id TEXT PRIMARY KEY, - web_log_id TEXT NOT NULL REFERENCES web_log (id), - user_name TEXT NOT NULL, - first_name TEXT NOT NULL, - last_name TEXT NOT NULL, - preferred_name TEXT NOT NULL, - password_hash TEXT NOT NULL, - salt TEXT NOT NULL, - url TEXT, - authorization_level TEXT NOT NULL); + id TEXT PRIMARY KEY, + web_log_id TEXT NOT NULL REFERENCES web_log (id), + user_name TEXT NOT NULL, + first_name TEXT NOT NULL, + last_name TEXT NOT NULL, + preferred_name TEXT NOT NULL, + password_hash TEXT NOT NULL, + salt TEXT NOT NULL, + url TEXT, + access_level TEXT NOT NULL); CREATE INDEX web_log_user_web_log_idx ON web_log_user (web_log_id); CREATE INDEX web_log_user_user_name_idx ON web_log_user (web_log_id, user_name)""" do! write cmd diff --git a/src/MyWebLog.Domain/DataTypes.fs b/src/MyWebLog.Domain/DataTypes.fs index 7a2437e..8c285b1 100644 --- a/src/MyWebLog.Domain/DataTypes.fs +++ b/src/MyWebLog.Domain/DataTypes.fs @@ -436,8 +436,8 @@ type WebLogUser = /// The URL of the user's personal site url : string option - /// The user's authorization level - authorizationLevel : AuthorizationLevel + /// The user's access level + accessLevel : AccessLevel } /// Functions to support web log users @@ -445,16 +445,16 @@ module WebLogUser = /// An empty web log user let empty = - { id = WebLogUserId.empty - webLogId = WebLogId.empty - userName = "" - firstName = "" - lastName = "" - preferredName = "" - passwordHash = "" - salt = Guid.Empty - url = None - authorizationLevel = User + { id = WebLogUserId.empty + webLogId = WebLogId.empty + userName = "" + firstName = "" + lastName = "" + preferredName = "" + passwordHash = "" + salt = Guid.Empty + url = None + accessLevel = Author } /// Get the user's displayed name @@ -463,3 +463,7 @@ module WebLogUser = seq { match user.preferredName with "" -> user.firstName | n -> n; " "; user.lastName } |> Seq.reduce (+) name.Trim () + + /// Does a user have the required access level? + let hasAccess level user = + AccessLevel.hasAccess level user.accessLevel diff --git a/src/MyWebLog.Domain/SupportTypes.fs b/src/MyWebLog.Domain/SupportTypes.fs index f18ba6f..379128b 100644 --- a/src/MyWebLog.Domain/SupportTypes.fs +++ b/src/MyWebLog.Domain/SupportTypes.fs @@ -12,6 +12,51 @@ module private Helpers = Convert.ToBase64String(Guid.NewGuid().ToByteArray()).Replace('/', '_').Replace('+', '-').Substring (0, 22) +/// A user's access level +type AccessLevel = + /// The user may create and publish posts and edit the ones they have created + | Author + /// The user may edit posts they did not create, but may not delete them + | Editor + /// The user may delete posts and configure web log settings + | WebLogAdmin + /// The user may manage themes (which affects all web logs for an installation) + | Administrator + +/// Functions to support access levels +module AccessLevel = + + /// Weightings for access levels + let private weights = + [ Author, 10 + Editor, 20 + WebLogAdmin, 30 + Administrator, 40 + ] + |> Map.ofList + + /// Convert an access level to its string representation + let toString = + function + | Author -> "Author" + | Editor -> "Editor" + | WebLogAdmin -> "WebLogAdmin" + | Administrator -> "Administrator" + + /// Parse an access level from its string representation + let parse it = + match it with + | "Author" -> Author + | "Editor" -> Editor + | "WebLogAdmin" -> WebLogAdmin + | "Administrator" -> Administrator + | _ -> invalidOp $"{it} is not a valid access level" + + /// Does a given access level allow an action that requires a certain access level? + let hasAccess needed held = + weights[needed] <= weights[held] + + /// An identifier for a category type CategoryId = CategoryId of string @@ -607,26 +652,6 @@ module WebLogId = let create () = WebLogId (newId ()) -/// A level of authorization for a given web log -type AuthorizationLevel = - /// The user may administer all aspects of a web log - | Administrator - /// The user is a known user of a web log - | User - -/// Functions to support authorization levels -module AuthorizationLevel = - - /// Convert an authorization level to a string - let toString = function Administrator -> "Administrator" | User -> "User" - - /// Parse a string into an authorization level - let parse value = - match value with - | "Administrator" -> Administrator - | "User" -> User - | it -> invalidOp $"{it} is not a valid authorization level" - /// An identifier for a web log user type WebLogUserId = WebLogUserId of string diff --git a/src/MyWebLog/Handlers/User.fs b/src/MyWebLog/Handlers/User.fs index b22129a..e762ac2 100644 --- a/src/MyWebLog/Handlers/User.fs +++ b/src/MyWebLog/Handlers/User.fs @@ -47,7 +47,7 @@ let doLogOn : HttpHandler = fun next ctx -> task { Claim (ClaimTypes.NameIdentifier, WebLogUserId.toString user.id) Claim (ClaimTypes.Name, $"{user.firstName} {user.lastName}") Claim (ClaimTypes.GivenName, user.preferredName) - Claim (ClaimTypes.Role, user.authorizationLevel.ToString ()) + Claim (ClaimTypes.Role, AccessLevel.toString user.accessLevel) } let identity = ClaimsIdentity (claims, CookieAuthenticationDefaults.AuthenticationScheme) diff --git a/src/MyWebLog/Maintenance.fs b/src/MyWebLog/Maintenance.fs index 09dcb63..c92bd10 100644 --- a/src/MyWebLog/Maintenance.fs +++ b/src/MyWebLog/Maintenance.fs @@ -40,15 +40,15 @@ let private doCreateWebLog (args : string[]) (sp : IServiceProvider) = task { do! data.WebLogUser.add { WebLogUser.empty with - id = userId - webLogId = webLogId - userName = args[3] - firstName = "Admin" - lastName = "User" - preferredName = "Admin" - passwordHash = Handlers.User.hashedPassword args[4] args[3] salt - salt = salt - authorizationLevel = Administrator + id = userId + webLogId = webLogId + userName = args[3] + firstName = "Admin" + lastName = "User" + preferredName = "Admin" + passwordHash = Handlers.User.hashedPassword args[4] args[3] salt + salt = salt + accessLevel = Administrator } // Create the default home page