Skip to content

Commit

Permalink
Delete user / admin clean-up (#19)
Browse files Browse the repository at this point in the history 
- Add CLI help (#22)
- Add constants for common view items
- Construct hashes with piped functions
  • Loading branch information
@danieljsummers
danieljsummers committed Jul 22, 2022
1 parent 59f3851 commit 99ccdeb
Show file tree
Hide file tree
Showing 13 changed files with 499 additions and 302 deletions.
3 changes: 3 additions & 0 deletions src/MyWebLog.Data/Interfaces.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -255,6 +255,9 @@ type IWebLogUserData =
/// Add a web log user
abstract member Add : WebLogUser -> Task<unit>

/// Delete a web log user
abstract member Delete : WebLogUserId -> WebLogId -> Task<Result<bool, string>>

/// Find a web log user by their e-mail address
abstract member FindByEmail : email : string -> WebLogId -> Task<WebLogUser option>

Expand Down
47 changes: 39 additions & 8 deletions src/MyWebLog.Data/RethinkDbData.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -955,6 +955,44 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
write; withRetryDefault; ignoreResult conn
}

member _.FindById userId webLogId =
rethink<WebLogUser> {
withTable Table.WebLogUser
get userId
resultOption; withRetryOptionDefault
}
|> verifyWebLog webLogId (fun u -> u.WebLogId) <| conn

member this.Delete userId webLogId = backgroundTask {
match! this.FindById userId webLogId with
| Some _ ->
let! pageCount = rethink<int> {
withTable Table.Page
getAll [ webLogId ] (nameof Page.empty.WebLogId)
filter (nameof Page.empty.AuthorId) userId
count
result; withRetryDefault conn
}
let! postCount = rethink<int> {
withTable Table.Post
getAll [ webLogId ] (nameof Post.empty.WebLogId)
filter (nameof Post.empty.AuthorId) userId
count
result; withRetryDefault conn
}
if pageCount + postCount > 0 then
return Result.Error "User has pages or posts; cannot delete"
else
do! rethink {
withTable Table.WebLogUser
get userId
delete
write; withRetryDefault; ignoreResult conn
}
return Ok true
| None -> return Result.Error "User does not exist"
}

member _.FindByEmail email webLogId =
rethink<WebLogUser list> {
withTable Table.WebLogUser
Expand All @@ -964,17 +1002,10 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
}
|> tryFirst <| conn

member _.FindById userId webLogId =
rethink<WebLogUser> {
withTable Table.WebLogUser
get userId
resultOption; withRetryOptionDefault
}
|> verifyWebLog webLogId (fun u -> u.WebLogId) <| conn

member _.FindByWebLog webLogId = rethink<WebLogUser list> {
withTable Table.WebLogUser
getAll [ webLogId ] (nameof WebLogUser.empty.WebLogId)
orderByFunc (fun row -> row[nameof WebLogUser.empty.PreferredName].Downcase ())
result; withRetryDefault conn
}

Expand Down
40 changes: 30 additions & 10 deletions src/MyWebLog.Data/SQLite/SQLiteWebLogUserData.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -43,6 +43,34 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
do! write cmd
}

/// Find a user by their ID for the given web log
let findById userId webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM web_log_user WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString userId) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return Helpers.verifyWebLog<WebLogUser> webLogId (fun u -> u.WebLogId) Map.toWebLogUser rdr
}

/// Delete a user if they have no posts or pages
let delete userId webLogId = backgroundTask {
match! findById userId webLogId with
| Some _ ->
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT COUNT(id) FROM page WHERE author_id = @userId"
cmd.Parameters.AddWithValue ("@userId", WebLogUserId.toString userId) |> ignore
let! pageCount = count cmd
cmd.CommandText <- "SELECT COUNT(id) FROM post WHERE author_id = @userId"
let! postCount = count cmd
if pageCount + postCount > 0 then
return Error "User has pages or posts; cannot delete"
else
cmd.CommandText <- "DELETE FROM web_log_user WHERE id = @userId"
let! _ = cmd.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 : string) webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
Expand All @@ -53,19 +81,10 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =
return if rdr.Read () then Some (Map.toWebLogUser rdr) else None
}

/// Find a user by their ID for the given web log
let findById userId webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM web_log_user WHERE id = @id"
cmd.Parameters.AddWithValue ("@id", WebLogUserId.toString userId) |> ignore
use! rdr = cmd.ExecuteReaderAsync ()
return Helpers.verifyWebLog<WebLogUser> webLogId (fun u -> u.WebLogId) Map.toWebLogUser rdr
}

/// Get all users for the given web log
let findByWebLog webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- "SELECT * FROM web_log_user WHERE web_log_id = @webLogId"
cmd.CommandText <- "SELECT * FROM web_log_user WHERE web_log_id = @webLogId ORDER BY LOWER(preferred_name)"
addWebLogId cmd webLogId
use! rdr = cmd.ExecuteReaderAsync ()
return toList Map.toWebLogUser rdr
Expand Down Expand Up @@ -133,6 +152,7 @@ type SQLiteWebLogUserData (conn : SqliteConnection) =

interface IWebLogUserData with
member _.Add user = add 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
Expand Down
115 changes: 53 additions & 62 deletions src/MyWebLog/Handlers/Admin.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -18,41 +18,37 @@ let dashboard : HttpHandler = requireAccess Author >=> fun next ctx -> task {
let topCats = getCount data.Category.CountTopLevel
let! _ = Task.WhenAll (posts, drafts, pages, listed, cats, topCats)
return!
{| page_title = "Dashboard"
model =
{ Posts = posts.Result
Drafts = drafts.Result
Pages = pages.Result
ListedPages = listed.Result
Categories = cats.Result
TopLevelCategories = topCats.Result
}
|}
|> makeHash |> adminView "dashboard" next ctx
hashForPage "Dashboard"
|> addToHash ViewContext.Model {
Posts = posts.Result
Drafts = drafts.Result
Pages = pages.Result
ListedPages = listed.Result
Categories = cats.Result
TopLevelCategories = topCats.Result
}
|> adminView "dashboard" next ctx
}

// -- CATEGORIES --

// GET /admin/categories
let listCategories : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
let! catListTemplate = TemplateCache.get "admin" "category-list-body" ctx.Data
let hash = makeHash {|
page_title = "Categories"
csrf = ctx.CsrfTokenSet
web_log = ctx.WebLog
categories = CategoryCache.get ctx
|}
let! hash =
hashForPage "Categories"
|> withAntiCsrf ctx
|> addViewContext ctx
return!
addToHash "category_list" (catListTemplate.Render hash) hash
|> adminView "category-list" next ctx
}

// GET /admin/categories/bare
let listCategoriesBare : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
{| categories = CategoryCache.get ctx
csrf = ctx.CsrfTokenSet
|}
|> makeHash |> adminBareView "category-list-body" next ctx
hashForPage "Categories"
|> withAntiCsrf ctx
|> adminBareView "category-list-body" next ctx


// GET /admin/category/{id}/edit
Expand All @@ -67,13 +63,11 @@ let editCategory catId : HttpHandler = requireAccess WebLogAdmin >=> fun next ct
}
match result with
| Some (title, cat) ->
return! {|
page_title = title
csrf = ctx.CsrfTokenSet
model = EditCategoryModel.fromCategory cat
categories = CategoryCache.get ctx
|}
|> makeHash |> adminBareView "category-edit" next ctx
return!
hashForPage title
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (EditCategoryModel.fromCategory cat)
|> adminBareView "category-edit" next ctx
| None -> return! Error.notFound next ctx
}

Expand Down Expand Up @@ -117,12 +111,12 @@ open Microsoft.AspNetCore.Http
/// Get the hash necessary to render the tag mapping list
let private tagMappingHash (ctx : HttpContext) = task {
let! mappings = ctx.Data.TagMap.FindByWebLog ctx.WebLog.Id
return makeHash {|
csrf = ctx.CsrfTokenSet
web_log = ctx.WebLog
mappings = mappings
mapping_ids = mappings |> List.map (fun it -> { Name = it.Tag; Value = TagMapId.toString it.Id })
|}
return!
hashForPage "Tag Mappings"
|> withAntiCsrf ctx
|> addToHash "mappings" mappings
|> addToHash "mapping_ids" (mappings |> List.map (fun it -> { Name = it.Tag; Value = TagMapId.toString it.Id }))
|> addViewContext ctx
}

// GET /admin/settings/tag-mappings
Expand All @@ -131,7 +125,6 @@ let tagMappings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> ta
let! listTemplate = TemplateCache.get "admin" "tag-mapping-list-body" ctx.Data
return!
addToHash "tag_mapping_list" (listTemplate.Render hash) hash
|> addToHash "page_title" "Tag Mappings"
|> adminView "tag-mapping-list" next ctx
}

Expand All @@ -149,12 +142,11 @@ let editMapping tagMapId : HttpHandler = requireAccess WebLogAdmin >=> fun next
else ctx.Data.TagMap.FindById (TagMapId tagMapId) ctx.WebLog.Id
match! tagMap with
| Some tm ->
return! {|
page_title = if isNew then "Add Tag Mapping" else $"Mapping for {tm.Tag} Tag"
csrf = ctx.CsrfTokenSet
model = EditTagMapModel.fromMapping tm
|}
|> makeHash |> adminBareView "tag-mapping-edit" next ctx
return!
hashForPage (if isNew then "Add Tag Mapping" else $"Mapping for {tm.Tag} Tag")
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (EditTagMapModel.fromMapping tm)
|> adminBareView "tag-mapping-edit" next ctx
| None -> return! Error.notFound next ctx
}

Expand Down Expand Up @@ -191,10 +183,9 @@ open MyWebLog.Data

// GET /admin/theme/update
let themeUpdatePage : HttpHandler = requireAccess Administrator >=> fun next ctx ->
{| page_title = "Upload Theme"
csrf = ctx.CsrfTokenSet
|}
|> makeHash |> adminView "upload-theme" next ctx
hashForPage "Upload Theme"
|> withAntiCsrf ctx
|> adminView "upload-theme" next ctx

/// Update the name and version for a theme based on the version.txt file, if present
let private updateNameAndVersion (theme : Theme) (zip : ZipArchive) = backgroundTask {
Expand Down Expand Up @@ -244,9 +235,9 @@ let private updateAssets themeId (zip : ZipArchive) (data : IData) = backgroundT
use stream = new MemoryStream ()
do! asset.Open().CopyToAsync stream
do! data.ThemeAsset.Save
{ Id = ThemeAssetId (themeId, assetName)
UpdatedOn = asset.LastWriteTime.DateTime
Data = stream.ToArray ()
{ Id = ThemeAssetId (themeId, assetName)
UpdatedOn = asset.LastWriteTime.DateTime
Data = stream.ToArray ()
}
}

Expand Down Expand Up @@ -303,28 +294,28 @@ let settings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task
let data = ctx.Data
let! allPages = data.Page.All ctx.WebLog.Id
let! themes = data.Theme.All ()
return! {|
page_title = "Web Log Settings"
csrf = ctx.CsrfTokenSet
model = SettingsModel.fromWebLog ctx.WebLog
pages = seq
{ KeyValuePair.Create ("posts", "- First Page of Posts -")
return!
hashForPage "Web Log Settings"
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (SettingsModel.fromWebLog ctx.WebLog)
|> addToHash "pages" (
seq {
KeyValuePair.Create ("posts", "- First Page of Posts -")
yield! allPages
|> List.sortBy (fun p -> p.Title.ToLower ())
|> List.map (fun p -> KeyValuePair.Create (PageId.toString p.Id, p.Title))
}
|> Array.ofSeq
themes =
|> Array.ofSeq)
|> addToHash "themes" (
themes
|> Seq.ofList
|> Seq.map (fun it -> KeyValuePair.Create (ThemeId.toString it.Id, $"{it.Name} (v{it.Version})"))
|> Array.ofSeq
upload_values = [|
|> Seq.ofList
|> Seq.map (fun it -> KeyValuePair.Create (ThemeId.toString it.Id, $"{it.Name} (v{it.Version})"))
|> Array.ofSeq)
|> addToHash "upload_values" [|
KeyValuePair.Create (UploadDestination.toString Database, "Database")
KeyValuePair.Create (UploadDestination.toString Disk, "Disk")
|]
|}
|> makeHash |> adminView "settings" next ctx
|> adminView "settings" next ctx
}

// POST /admin/settings
Expand Down
44 changes: 20 additions & 24 deletions src/MyWebLog/Handlers/Feed.fs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -416,16 +416,14 @@ let generate (feedType : FeedType) postCount : HttpHandler = fun next ctx -> bac

// GET /admin/settings/rss
let editSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx ->
let feeds =
hashForPage "RSS Settings"
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (EditRssModel.fromRssOptions ctx.WebLog.Rss)
|> addToHash "custom_feeds" (
ctx.WebLog.Rss.CustomFeeds
|> List.map (DisplayCustomFeed.fromFeed (CategoryCache.get ctx))
|> Array.ofList
{| page_title = "RSS Settings"
csrf = ctx.CsrfTokenSet
model = EditRssModel.fromRssOptions ctx.WebLog.Rss
custom_feeds = feeds
|}
|> makeHash |> adminView "rss-settings" next ctx
|> Array.ofList)
|> adminView "rss-settings" next ctx

// POST /admin/settings/rss
let saveSettings : HttpHandler = requireAccess WebLogAdmin >=> fun next ctx -> task {
Expand All @@ -449,22 +447,20 @@ let editCustomFeed feedId : HttpHandler = requireAccess WebLogAdmin >=> fun next
| _ -> ctx.WebLog.Rss.CustomFeeds |> List.tryFind (fun f -> f.Id = CustomFeedId feedId)
match customFeed with
| Some f ->
{| page_title = $"""{if feedId = "new" then "Add" else "Edit"} Custom RSS Feed"""
csrf = ctx.CsrfTokenSet
model = EditCustomFeedModel.fromFeed f
categories = CategoryCache.get ctx
medium_values = [|
KeyValuePair.Create ("", "&ndash; Unspecified &ndash;")
KeyValuePair.Create (PodcastMedium.toString Podcast, "Podcast")
KeyValuePair.Create (PodcastMedium.toString Music, "Music")
KeyValuePair.Create (PodcastMedium.toString Video, "Video")
KeyValuePair.Create (PodcastMedium.toString Film, "Film")
KeyValuePair.Create (PodcastMedium.toString Audiobook, "Audiobook")
KeyValuePair.Create (PodcastMedium.toString Newsletter, "Newsletter")
KeyValuePair.Create (PodcastMedium.toString Blog, "Blog")
|]
|}
|> makeHash |> adminView "custom-feed-edit" next ctx
hashForPage $"""{if feedId = "new" then "Add" else "Edit"} Custom RSS Feed"""
|> withAntiCsrf ctx
|> addToHash ViewContext.Model (EditCustomFeedModel.fromFeed f)
|> addToHash "medium_values" [|
KeyValuePair.Create ("", "&ndash; Unspecified &ndash;")
KeyValuePair.Create (PodcastMedium.toString Podcast, "Podcast")
KeyValuePair.Create (PodcastMedium.toString Music, "Music")
KeyValuePair.Create (PodcastMedium.toString Video, "Video")
KeyValuePair.Create (PodcastMedium.toString Film, "Film")
KeyValuePair.Create (PodcastMedium.toString Audiobook, "Audiobook")
KeyValuePair.Create (PodcastMedium.toString Newsletter, "Newsletter")
KeyValuePair.Create (PodcastMedium.toString Blog, "Blog")
|]
|> adminView "custom-feed-edit" next ctx
| None -> Error.notFound next ctx

// POST /admin/settings/rss/save
Expand Down
Loading

0 comments on commit 99ccdeb

Please sign in to comment.