From c9572791625f1379003914ef7b5be172f60eb51a Mon Sep 17 00:00:00 2001 From: "Daniel J. Summers" Date: Mon, 4 Jul 2022 13:19:16 -0400 Subject: [PATCH] Add and delete uploaded files (#2) --- .gitignore | 3 + src/MyWebLog.Data/Interfaces.fs | 3 + src/MyWebLog.Data/RethinkDbData.fs | 22 ++++++- src/MyWebLog.Data/SQLite/SQLiteUploadData.fs | 22 +++++++ src/MyWebLog.Domain/ViewModels.fs | 4 +- src/MyWebLog/DotLiquidBespoke.fs | 4 +- src/MyWebLog/Handlers/Routes.fs | 4 +- src/MyWebLog/Handlers/Upload.fs | 64 +++++++++++++++++--- src/admin-theme/upload-list.liquid | 11 +++- 9 files changed, 122 insertions(+), 15 deletions(-) diff --git a/.gitignore b/.gitignore index 0130e86..170e429 100644 --- a/.gitignore +++ b/.gitignore @@ -262,3 +262,6 @@ src/MyWebLog/wwwroot/img/bit-badger .ionide src/MyWebLog/appsettings.Production.json + +# SQLite database files +src/MyWebLog/*.db* diff --git a/src/MyWebLog.Data/Interfaces.fs b/src/MyWebLog.Data/Interfaces.fs index c0af2f9..4977ea6 100644 --- a/src/MyWebLog.Data/Interfaces.fs +++ b/src/MyWebLog.Data/Interfaces.fs @@ -205,6 +205,9 @@ type IUploadData = /// Add an uploaded file abstract member add : Upload -> Task + /// Delete an uploaded file + abstract member delete : UploadId -> WebLogId -> Task> + /// Find an uploaded file by its path for the given web log abstract member findByPath : string -> WebLogId -> Task diff --git a/src/MyWebLog.Data/RethinkDbData.fs b/src/MyWebLog.Data/RethinkDbData.fs index af706e9..4b653a7 100644 --- a/src/MyWebLog.Data/RethinkDbData.fs +++ b/src/MyWebLog.Data/RethinkDbData.fs @@ -746,10 +746,30 @@ type RethinkDbData (conn : Net.IConnection, config : DataConfig, log : ILogger { + withTable Table.Upload + get uploadId + resultOption; withRetryOptionDefault + } + |> verifyWebLog 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 { withTable Table.Upload - getAll [ r.Array (path, webLogId) ] "webLogAndPath" + getAll [ r.Array (webLogId, path) ] "webLogAndPath" resultCursor; withRetryCursorDefault; toList } |> tryFirst <| conn diff --git a/src/MyWebLog.Data/SQLite/SQLiteUploadData.fs b/src/MyWebLog.Data/SQLite/SQLiteUploadData.fs index e2d8b5c..1af4d69 100644 --- a/src/MyWebLog.Data/SQLite/SQLiteUploadData.fs +++ b/src/MyWebLog.Data/SQLite/SQLiteUploadData.fs @@ -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 diff --git a/src/MyWebLog.Domain/ViewModels.fs b/src/MyWebLog.Domain/ViewModels.fs index c237282..3a5bfec 100644 --- a/src/MyWebLog.Domain/ViewModels.fs +++ b/src/MyWebLog.Domain/ViewModels.fs @@ -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 } diff --git a/src/MyWebLog/DotLiquidBespoke.fs b/src/MyWebLog/DotLiquidBespoke.fs index 87ad11b..c004fa3 100644 --- a/src/MyWebLog/DotLiquidBespoke.fs +++ b/src/MyWebLog/DotLiquidBespoke.fs @@ -232,7 +232,7 @@ let register () = typeof; typeof; typeof; typeof typeof; typeof // Framework types - typeof; typeof; typeof; typeof - typeof; typeof; typeof + typeof; typeof; typeof; typeof + typeof; typeof; typeof; typeof ] |> List.iter (fun it -> Template.RegisterSafeType (it, [| "*" |])) diff --git a/src/MyWebLog/Handlers/Routes.fs b/src/MyWebLog/Handlers/Routes.fs index e0e8a1b..d6c9989 100644 --- a/src/MyWebLog/Handlers/Routes.fs +++ b/src/MyWebLog/Handlers/Routes.fs @@ -178,7 +178,9 @@ let router : HttpHandler = choose [ ]) route "/theme/update" >=> Admin.updateTheme subRoute "/upload" (choose [ - route "/save" >=> Upload.save + route "/save" >=> Upload.save + routexp "/delete/(.*)" Upload.deleteFromDisk + routef "/%s/delete" Upload.deleteFromDb ]) route "/user/save" >=> User.save ] diff --git a/src/MyWebLog/Handlers/Upload.fs b/src/MyWebLog/Handlers/Upload.fs index 35d6e37..af2783d 100644 --- a/src/MyWebLog/Handlers/Upload.fs +++ b/src/MyWebLog/Handlers/Upload.fs @@ -2,6 +2,7 @@ module MyWebLog.Handlers.Upload open System +open System.IO open Giraffe open Microsoft.AspNetCore.Http open Microsoft.Net.Http.Headers @@ -21,6 +22,12 @@ module private Helpers = let hdr = CacheControlHeaderValue() 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 @@ -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,12 +136,17 @@ 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), - Path.GetExtension(upload.FileName).ToLowerInvariant ()) + 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 let year = localNow.ToString "yyyy" @@ -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 +} diff --git a/src/admin-theme/upload-list.liquid b/src/admin-theme/upload-list.liquid index 3e1adf9..48f698a 100644 --- a/src/admin-theme/upload-list.liquid +++ b/src/admin-theme/upload-list.liquid @@ -46,7 +46,16 @@ {%- endunless %} Link • - Delete + {%- capture delete_url -%} + {%- if file.source == "disk" -%} + admin/upload/delete/{{ file.path }}{{ file.name }} + {%- else -%} + admin/upload/{{ file.id }}/delete + {%- endif -%} + {%- endcapture -%} + Delete
{{ file.path }}