Add and delete uploaded files (#2)

This commit is contained in:
Daniel J. Summers 2022-07-04 13:19:16 -04:00
parent 9307ace24a
commit c957279162
9 changed files with 122 additions and 15 deletions

3
.gitignore vendored
View File

@ -262,3 +262,6 @@ src/MyWebLog/wwwroot/img/bit-badger
.ionide
src/MyWebLog/appsettings.Production.json
# SQLite database files
src/MyWebLog/*.db*

View File

@ -205,6 +205,9 @@ type IUploadData =
/// Add an uploaded file
abstract member add : Upload -> Task<unit>
/// Delete an uploaded file
abstract member delete : UploadId -> WebLogId -> Task<Result<string, string>>
/// Find an uploaded file by its path for the given web log
abstract member findByPath : string -> WebLogId -> Task<Upload option>

View File

@ -746,10 +746,30 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger<R
write; withRetryDefault; ignoreResult conn
}
member _.delete uploadId webLogId = backgroundTask {
let! upload =
rethink<Upload> {
withTable Table.Upload
get uploadId
resultOption; withRetryOptionDefault
}
|> verifyWebLog<Upload> webLogId (fun u -> u.webLogId) <| conn
match upload with
| Some up ->
do! rethink {
withTable Table.Upload
get uploadId
delete
write; withRetryDefault; ignoreResult conn
}
return Ok (Permalink.toString up.path)
| None -> return Result.Error $"Upload ID {UploadId.toString uploadId} not found"
}
member _.findByPath path webLogId =
rethink<Upload> {
withTable Table.Upload
getAll [ r.Array (path, webLogId) ] "webLogAndPath"
getAll [ r.Array (webLogId, path) ] "webLogAndPath"
resultCursor; withRetryCursorDefault; toList
}
|> tryFirst <| conn

View File

@ -37,6 +37,27 @@ type SQLiteUploadData (conn : SqliteConnection) =
do! dataStream.CopyToAsync blobStream
}
/// Delete an uploaded file by its ID
let delete uploadId webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
cmd.CommandText <- """
SELECT id, web_log_id, path, updated_on
FROM upload
WHERE id = @id
AND web_log_id = @webLogId"""
addWebLogId cmd webLogId
cmd.Parameters.AddWithValue ("@id", UploadId.toString uploadId) |> ignore
let! rdr = cmd.ExecuteReaderAsync ()
if (rdr.Read ()) then
let upload = Map.toUpload false rdr
do! rdr.CloseAsync ()
cmd.CommandText <- "DELETE FROM upload WHERE id = @id AND web_log_id = @webLogId"
do! write cmd
return Ok (Permalink.toString upload.path)
else
return Error $"""Upload ID {cmd.Parameters["@id"]} not found"""
}
/// Find an uploaded file by its path for the given web log
let findByPath (path : string) webLogId = backgroundTask {
use cmd = conn.CreateCommand ()
@ -72,6 +93,7 @@ type SQLiteUploadData (conn : SqliteConnection) =
interface IUploadData with
member _.add upload = add upload
member _.delete uploadId webLogId = delete uploadId webLogId
member _.findByPath path webLogId = findByPath path webLogId
member _.findByWebLog webLogId = findByWebLog webLogId
member _.findByWebLogWithData webLogId = findByWebLogWithData webLogId

View File

@ -169,13 +169,13 @@ type DisplayUpload =
}
/// Create a display uploaded file
static member fromUpload source (upload : Upload) =
static member fromUpload webLog source (upload : Upload) =
let path = Permalink.toString upload.path
let name = Path.GetFileName path
{ id = UploadId.toString upload.id
name = name
path = path.Replace (name, "")
updatedOn = Some upload.updatedOn
updatedOn = Some (WebLog.localTime webLog upload.updatedOn)
source = UploadDestination.toString source
}

View File

@ -232,7 +232,7 @@ let register () =
typeof<LogOnModel>; typeof<ManagePermalinksModel>; typeof<PostDisplay>; typeof<PostListItem>
typeof<SettingsModel>; typeof<UserMessage>
// Framework types
typeof<AntiforgeryTokenSet>; typeof<int option>; typeof<KeyValuePair>; typeof<MetaItem list>
typeof<string list>; typeof<string option>; typeof<TagMap list>
typeof<AntiforgeryTokenSet>; typeof<DateTime option>; typeof<int option>; typeof<KeyValuePair>
typeof<MetaItem list>; typeof<string list>; typeof<string option>; typeof<TagMap list>
]
|> List.iter (fun it -> Template.RegisterSafeType (it, [| "*" |]))

View File

@ -179,6 +179,8 @@ let router : HttpHandler = choose [
route "/theme/update" >=> Admin.updateTheme
subRoute "/upload" (choose [
route "/save" >=> Upload.save
routexp "/delete/(.*)" Upload.deleteFromDisk
routef "/%s/delete" Upload.deleteFromDb
])
route "/user/save" >=> User.save
]

View File

@ -2,6 +2,7 @@
module MyWebLog.Handlers.Upload
open System
open System.IO
open Giraffe
open Microsoft.AspNetCore.Http
open Microsoft.Net.Http.Headers
@ -22,6 +23,12 @@ module private Helpers =
hdr.MaxAge <- Some (TimeSpan.FromDays 30) |> Option.toNullable
hdr
/// Shorthand for the directory separator
let slash = Path.DirectorySeparatorChar
/// The base directory where uploads are stored, relative to the executable
let uploadDir = Path.Combine ("wwwroot", "upload")
/// Determine if the file has been modified since the date/time specified by the If-Modified-Since header
let checkModified since (ctx : HttpContext) : HttpHandler option =
@ -31,7 +38,6 @@ let checkModified since (ctx : HttpContext) : HttpHandler option =
| _ -> Some (setStatusCode 304 >=> setBodyFromString "Not Modified")
open System.IO
open Microsoft.AspNetCore.Http.Headers
/// Derive a MIME type based on the extension of the file
@ -83,7 +89,7 @@ let list : HttpHandler = fun next ctx -> task {
let webLog = ctx.WebLog
let! dbUploads = ctx.Data.Upload.findByWebLog webLog.id
let diskUploads =
let path = Path.Combine ("wwwroot", "upload", webLog.slug)
let path = Path.Combine (uploadDir, webLog.slug)
try
Directory.EnumerateFiles (path, "*", SearchOption.AllDirectories)
|> Seq.map (fun file ->
@ -94,7 +100,7 @@ let list : HttpHandler = fun next ctx -> task {
| _ -> None
{ DisplayUpload.id = ""
name = name
path = file.Replace($"{path}/", "").Replace (name, "")
path = file.Replace($"{path}{slash}", "").Replace(name, "").Replace (slash, '/')
updatedOn = create
source = UploadDestination.toString Disk
})
@ -106,7 +112,7 @@ let list : HttpHandler = fun next ctx -> task {
[]
let allFiles =
dbUploads
|> List.map (DisplayUpload.fromUpload Database)
|> List.map (DisplayUpload.fromUpload webLog Database)
|> List.append diskUploads
|> List.sortByDescending (fun file -> file.updatedOn, file.path)
@ -130,11 +136,16 @@ let showNew : HttpHandler = fun next ctx -> task {
|> viewForTheme "admin" "upload-new" next ctx
}
/// Redirect to the upload list
let showUploads : HttpHandler = fun next ctx -> task {
return! redirectToGet (WebLog.relativeUrl ctx.WebLog (Permalink "admin/uploads")) next ctx
}
// POST /admin/upload/save
let save : HttpHandler = fun next ctx -> task {
if ctx.Request.HasFormContentType && ctx.Request.Form.Files.Count > 0 then
let upload = Seq.head ctx.Request.Form.Files
let fileName = String.Join ('.', makeSlug (Path.GetFileNameWithoutExtension upload.FileName),
let fileName = String.Concat (makeSlug (Path.GetFileNameWithoutExtension upload.FileName),
Path.GetExtension(upload.FileName).ToLowerInvariant ())
let webLog = ctx.WebLog
let localNow = WebLog.localTime webLog DateTime.Now
@ -155,13 +166,50 @@ let save : HttpHandler = fun next ctx -> task {
}
do! ctx.Data.Upload.add file
| Disk ->
let fullPath = Path.Combine ("wwwroot", webLog.slug, year, month)
let fullPath = Path.Combine (uploadDir, webLog.slug, year, month)
let _ = Directory.CreateDirectory fullPath
use stream = new FileStream (Path.Combine (fullPath, fileName), FileMode.Create)
do! upload.CopyToAsync stream
do! addMessage ctx { UserMessage.success with message = $"File uploaded to {form.destination} successfully" }
return! redirectToGet (WebLog.relativeUrl ctx.WebLog (Permalink "admin/uploads")) next ctx
return! showUploads next ctx
else
return! RequestErrors.BAD_REQUEST "Bad request; no file present" next ctx
}
// POST /admin/upload/{id}/delete
let deleteFromDb upId : HttpHandler = fun next ctx -> task {
let uploadId = UploadId upId
let webLog = ctx.WebLog
let data = ctx.Data
match! data.Upload.delete uploadId webLog.id with
| Ok fileName ->
do! addMessage ctx { UserMessage.success with message = $"{fileName} deleted successfully" }
return! showUploads next ctx
| Error _ -> return! Error.notFound next ctx
}
/// Remove a directory tree if it is empty
let removeEmptyDirectories (webLog : WebLog) (filePath : string) =
let mutable path = Path.GetDirectoryName filePath
let mutable finished = false
while (not finished) && path > "" do
let fullPath = Path.Combine (uploadDir, webLog.slug, path)
if Directory.EnumerateFileSystemEntries fullPath |> Seq.isEmpty then
Directory.Delete fullPath
path <- String.Join(slash, path.Split slash |> Array.rev |> Array.skip 1 |> Array.rev)
else
finished <- true
// POST /admin/upload/delete/{**path}
let deleteFromDisk urlParts : HttpHandler = fun next ctx -> task {
let filePath = urlParts |> Seq.skip 1 |> Seq.head
let path = Path.Combine (uploadDir, ctx.WebLog.slug, filePath)
if File.Exists path then
File.Delete path
removeEmptyDirectories ctx.WebLog filePath
do! addMessage ctx { UserMessage.success with message = $"{filePath} deleted successfully" }
return! showUploads next ctx
else
return! Error.notFound next ctx
}

View File

@ -46,7 +46,16 @@
</a>
{%- endunless %}
<span class="text-muted"> Link &bull; </span>
<a href="#" onclick="" class="text-danger">Delete</a>
{%- capture delete_url -%}
{%- if file.source == "disk" -%}
admin/upload/delete/{{ file.path }}{{ file.name }}
{%- else -%}
admin/upload/{{ file.id }}/delete
{%- endif -%}
{%- endcapture -%}
<a href="{{ delete_url | relative_link }}" hx-post="{{ delete_url | relative_link }}"
hx-confirm="Are you sure you want to delete {{ file.name }}? This action cannot be undone."
class="text-danger">Delete</a>
</small>
</div>
<div class="col-3">{{ file.path }}</div>