Merge branch 'feature/functional_rewrite'

src/webapi/DownloadHandler.fs

@@ -2,37 +2,21 @@ module WebApi.DownloadHandler
 
 open System
 open System.Net.Mime
+open System.Numerics
 open System.Threading.Tasks
 open Microsoft.AspNetCore.Http
 open FSharp.Control.Tasks.V2.ContextInsensitive
 open Microsoft.Extensions.Primitives
 open Giraffe
 open WebApi
-open WebApi
-open WebApi.Configuration
-
-/// <summary>
-/// Base path for all downloads. Is added to the filenames of all incoming requests.
-/// </summary>        
-let defaultBasePath = "/home/b0wter/tmp/torpedo"
-
-/// <summary>
-/// Default lifetime of a download. If the last file modification is older than this it is not considered a downloadable file.
-/// </summary>
-let defaultDownloadLifeTime = TimeSpan.FromDays(7.0)
-
-/// <summary>
-/// Default lifetime for a token once the first download has been attempted.
-/// </summary>
-let defaultTokenLifeTime = TimeSpan.FromDays(2.0)
 
 /// <summary>
-/// Creates a 404 response for the given context.
-/// </summary>
-let create404 (ctx: HttpContext) (next: HttpFunc) responseText =
-    ctx.Response.StatusCode <- 404
-    Views.badRequestView responseText |> htmlView
-    // (text responseText) next ctx    
+/// Sets the error status code and the error message in the given context.
+/// </Summary>
+let private failWithStatusCodeAndMessage (ctx: HttpContext) (next: HttpFunc) (statusCode: int) (message: string) =
+    do ctx.SetStatusCode(statusCode)
+    do ctx.Items.Add("errormessage", message)
+    next ctx
 
 /// <summary>
 /// Asynchronously writes a FileStream into a HTTP response.
@@ -51,55 +35,94 @@ let private getFileStreamResponseAsync file downloadname (ctx: HttpContext) (nex
                 None
                 None
         | None ->
-            return! (create404 ctx next "Download stream not set. Please contact the administrator.") next ctx
+            return! (failWithStatusCodeAndMessage ctx next 500 "Download stream not set. Please contact the administrator.")
     }
 
 /// <summary>
-/// Handler for download requests.
+/// Uses the given filename and the base path from the configuration too add these to
+/// and retrieve the path and the filename.
+/// </summary>
+/// <remarks>
+/// This is useful because the filename might contains a relative path oder a folder name.
 /// </summary>        
-let handleGetFileDownload : HttpHandler =
+let private createCompletePathAndFilename basePath filename =
+    let fullpath = IO.Path.Combine(basePath, filename)
+    let basePath = IO.Path.GetDirectoryName(fullpath)
+    let filename = IO.Path.GetFileName(fullpath);
+    (basePath, filename)
+
+/// <summary>
+/// Checks if the given HttpContext contains all of the given parameters als query parameters.
+/// Adds the parameter names and their values to the HttpContext.Items.
+/// </summary>
+let requiresQueryParameters (parameters: string seq) (addToContex: bool) : HttpHandler =
     fun (next: HttpFunc) (ctx: HttpContext) ->
-        let notAvailableBecause = create404 ctx next
-
-        match (ctx.GetQueryStringValue "filename", ctx.GetQueryStringValue "token") with 
-        | (Error _, _) -> notAvailableBecause "You need to supply a filename as query parameter." next ctx
-        | (_, Error _) -> notAvailableBecause "You need to supply a token as query parameters." next ctx
-        | (Ok filename, Ok tokenValue) ->
-            let filename = System.Net.WebUtility.UrlDecode(filename)
-            if filename.Contains("..") then 
-                notAvailableBecause "You cannot use '..' in filenames." next ctx
-            else
-                // Create some abbreviations.
-                let basePath = Configuration.Instance.BasePath
-                let fullpath = IO.Path.Combine(basePath, filename)
-                let basePath = IO.Path.GetDirectoryName(fullpath)
-                let filename = IO.Path.GetFileName(fullpath);
-                let downloadLifeTime = Configuration.Instance.DefaultDownloadLifeTime
-                let tokenLifeTime = Configuration.Instance.DefaultTokenLifeTime
+        task {
+            let queryParameters = parameters |> Seq.map (fun p -> (p, p |> ctx.TryGetQueryStringValue))
+
+            if queryParameters |> Seq.map snd |> Helpers.containsNone then 
+                return None
+            else 
+                let parametersToAdd = if addToContex then queryParameters else Seq.empty
+                parametersToAdd 
+                |> Seq.filter (fun (_, result) -> match result with 
+                                                  | Some s -> true 
+                                                  | None   -> false)
+                |> Seq.map (fun (name, result) -> (name, Option.get result))
+                |> Seq.iter (fun (name, value) -> ctx.Items <- Helpers.addIfNotExisting ctx.Items name value)
 
-                // Get the tuple containing the token and content filename.
-                let downloadPair = basePath 
-                                   |> FileAccess.getFilesWithTokens
-                                   |> Helpers.mappedFilter (fun (tokenfile, contentfile) -> (FileAccess.getLastModified tokenfile, (tokenfile, contentfile)))
-                                                           (fun (lastmodified, _) -> (DateTime.Now - downloadLifeTime) <= lastmodified)
-                                   |> Seq.tryFind (fun (_, contentfile) -> IO.Path.GetFileName(contentfile) = filename)
-
-                match downloadPair with 
-                | Some (tokenfilename, contentfilename) ->
-                    let tokenResult = tokenfilename |> FileAccess.getTextContent |> TokenSerializer.AsTotal |> (TokenSerializer.deserializeToken tokenfilename)
-                    match tokenResult with 
-                    | Ok token ->
-                        if token.Values |> Seq.map (fun v -> v.Value) |> Seq.contains tokenValue then
-
-                            // persist the token with its new expiration date (new expiration date is only set if it doesnt already exist, see method for details)
-                            Tokens.setExpirationTimeSpan tokenLifeTime token tokenValue
-                            |> TokenSerializer.serializeToken
-                            |> FileAccess.persistStringAsFile token.Filename
-
-                            getFileStreamResponseAsync contentfilename filename ctx next 
-                        else 
-                            notAvailableBecause "Unknown token." next ctx
-                    | Error err ->
-                        notAvailableBecause "Could not read token file. Please contact the system administrator." next ctx
-                | None ->
-                    notAvailableBecause (sprintf "The download is either unknown or has expired. The default lifetime of a download is %.1f days and it will expire %.1f days after you first download attempt." downloadLifeTime.TotalDays tokenLifeTime.TotalDays) next ctx
+                return! next ctx
+        }
+
+/// <summary>
+/// Checks if the context contains a filename item and if that filename points to an existing file.
+/// </summary>
+let requiresExistanceOfFileInContext (basePath: string) : HttpHandler =
+    fun (next: HttpFunc) (ctx: HttpContext) ->
+        task {
+            if ctx.Items.ContainsKey("filename") then 
+                let filename = ctx.Items.["filename"].ToString()
+                let filename = IO.Path.Combine(basePath, filename)
+                if filename |> FileAccess.fileExists then 
+                    return! (next ctx)
+                else
+                    ctx.Items.Add("errormessage", "File does not exist.")
+                    return None
+            else 
+                ctx.Items.Add("errormessage", "Context does not contain filename item.")
+                return None
+        }
+
+/// <summary>
+/// Searches for a given file, checks for valid tokens and returns a FileStream.
+/// </summary>        
+let getDownloadFilestream (basePath: string) (downloadLifeTime: TimeSpan) (tokenLifeTime: TimeSpan) : HttpHandler =
+    fun (next: HttpFunc) (ctx: HttpContext) ->
+        task {
+            let filename, tokenValue = (ctx.Items.["filename"].ToString(), ctx.Items.["token"].ToString())
+            let basePath, filename = filename |> createCompletePathAndFilename basePath
+            let downloadPair = basePath 
+                               |> FileAccess.getFilesWithTokens
+                               |> Helpers.mappedFilter (fun (tokenfile, contentfile) -> (FileAccess.getLastModified tokenfile, (tokenfile, contentfile)))
+                                                       (fun (lastmodified, _) -> (DateTime.Now - downloadLifeTime) <= lastmodified)
+                               |> Seq.tryFind (fun (_, contentfile) -> IO.Path.GetFileName(contentfile) = filename)
+            match downloadPair with 
+            | Some (tokenfilename, contentfilename) ->
+                let tokenResult = tokenfilename |> FileAccess.getTextContent |> TokenSerializer.AsTotal |> (TokenSerializer.deserializeToken tokenfilename)
+                match tokenResult with 
+                | Ok token ->
+                    if token.Values |> Seq.map (fun v -> v.Value) |> Seq.contains tokenValue then
+
+                        // persist the token with its new expiration date (new expiration date is only set if it doesnt already exist, see method for details)
+                        Tokens.setExpirationTimeSpan tokenLifeTime token tokenValue
+                        |> TokenSerializer.serializeToken
+                        |> FileAccess.persistStringAsFile token.Filename
+
+                        return! getFileStreamResponseAsync contentfilename filename ctx next 
+                    else 
+                        return! failWithStatusCodeAndMessage ctx next 404 "Unknown token."
+                | Error err ->
+                    return! failWithStatusCodeAndMessage ctx next 500 "Could not read token file. Please contact the system administrator."
+            | None ->
+                return! failWithStatusCodeAndMessage ctx next 400 (sprintf "The download is either unknown or has expired. The default lifetime of a download is %.1f days and it will expire %.1f days after you first download attempt." downloadLifeTime.TotalDays tokenLifeTime.TotalDays)
+        }        

src/webapi/FileAccess.fs

@@ -52,7 +52,20 @@ let getFileDates (filenames: string seq) =
 /// and the Token is uniquely bound to a single content file.
 /// </summary>
 let existsIn (folder: string) (filename: string): bool =
-    getFilesWithTokens folder |> Array.map snd |> Array.contains (Path.Combine(folder, filename))
+    if folder.Contains("..") || filename.Contains("..") then 
+        false 
+    else
+        getFilesWithTokens folder |> Array.map snd |> Array.contains (Path.Combine(folder, filename))
+
+/// <summary>
+/// Interprets the filename as a combination of directory and filename and checks if it exists.
+/// Will always return false if there is a ".." in the filename.
+/// </summary>    
+let fileExists (filename: string) : bool =
+    if filename.Contains("..") then
+        false 
+    else
+        File.Exists filename
 
 /// <summary>
 /// Tries to open a file stream for the given file. 

src/webapi/Helpers.fs

@@ -1,4 +1,6 @@
 module WebApi.Helpers
+open System.Collections.Generic
+open System.Linq
 open System.Runtime.CompilerServices
 
 /// <summary>
@@ -10,6 +12,12 @@ let mappedFilter (transformation: 'a->'b) (predicate: 'b -> bool) (items: 'a seq
     |> Seq.filter (fun (_, mappedItem) -> mappedItem |> predicate)
     |> Seq.map fst
 
+/// <summary>
+/// checks if the sequence contains a None element.
+/// </summary>
+let containsNone (items: seq<'a option>) : bool =
+    items |> Seq.exists (fun element -> match element with | Some _ -> false | None -> true)
+
 /// <summary>
 /// Checks if a collection of Result<...,...> contains at least one error value.
 /// </summary>
@@ -26,8 +34,32 @@ let filterOks (items: Result<'a, 'b> seq) : 'a seq =
                             | Error _    -> None)
     |> Seq.choose id                            
 
+/// <summary>
+/// Adds or appends a string with a given key to the given dictionary.
+/// In case the key exists the string is appended else it is added.
+/// </summary>
+let appendTo (items: IDictionary<obj, obj>) (key: string) (value: string) =
+    match items.ContainsKey(key) with 
+    | true ->
+        items.[key] <- items.[key].ToString() + value
+        items
+    | false ->
+        items.Add(key, value)
+        items
+
+/// <summary>
+/// Adds a string value with a string key to the dictionary in case the key does not exist.
+/// </summary>
+let addIfNotExisting (items: IDictionary<obj, obj>) (key: string) (value: string) =
+    match items.ContainsKey(key) with 
+    | true ->
+        items
+    | false ->
+        items.Add(key, value)
+        items                            
+
 [<Extension>]
 type System.String with
     static member IsNotNullOrWhiteSpace(s: string): bool =
         System.String.IsNullOrWhiteSpace(s) = false
-        
+

src/webapi/HttpHandlers.fs

@@ -11,4 +11,20 @@ module HttpHandlers =
     open Giraffe
     open WebApi
 
-// Room for additional HTTP handlers (non api).
+    let renderErrorCode : HttpHandler =
+        fun (next: HttpFunc) (ctx: HttpContext) ->
+            match ctx.Response.StatusCode with 
+            | 400 ->
+                let message = if ctx.Items.ContainsKey("errormessage") then ctx.Items.["errormessage"].ToString() else "Your request is invalid. Please try again or contact the site administrator."
+                let view = (Views.badRequestView message) |> htmlView
+                (view next ctx)
+            | 404 ->
+                let message = if ctx.Items.ContainsKey("errormessage") then ctx.Items.["errormessage"].ToString() else "The given resource could not be found."
+                let view = (Views.notFoundView message) |> htmlView
+                (view next ctx)
+            | 500 ->
+                let message = if ctx.Items.ContainsKey("errormessage") then ctx.Items.["errormessage"].ToString() else "An internal server error has occured. Please contact the system administrator."
+                let view = (Views.internalErrorView message) |> htmlView
+                (view next ctx)
+            | _ ->
+                next ctx

src/webapi/Models.fs

@@ -2,9 +2,3 @@ namespace Torpedo.Models
 
 open System
 
-[<CLIMutable>]
-type Download =
-    {
-        Filename: string
-        Token: string
-    }