Add and delete uploaded files (#2)

.gitignore

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

src/MyWebLog.Data/Interfaces.fs

@@ -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>
     

src/MyWebLog.Data/RethinkDbData.fs

@@ -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

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

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
         }
 

src/MyWebLog/DotLiquidBespoke.fs

@@ -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, [| "*" |]))

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
         ]

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
+}

src/admin-theme/upload-list.liquid

@@ -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>