From 9eb8f30f6ed4c00fd7bcc396efedf6580c5c1af8 Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sat, 6 Aug 2022 20:14:31 +0200 Subject: [PATCH 01/23] (#102) Web: add a dependency on Telegram link resolver --- Emulsion.Telegram/Client.fs | 12 +++++++++- Emulsion.Telegram/Funogram.fs | 18 +++++++++++---- Emulsion.Tests/Emulsion.Tests.fsproj | 1 + .../TestUtils/TelegramClientMock.fs | 15 ++++++++++++ Emulsion.Tests/Web/ContentControllerTests.fs | 10 ++++++-- Emulsion.Web/ContentController.fs | 14 ++++++----- Emulsion.Web/Emulsion.Web.fsproj | 1 + Emulsion.Web/WebServer.fs | 13 ++++++++--- Emulsion.sln.DotSettings | 1 + Emulsion/Program.fs | 23 ++++++++++--------- 10 files changed, 80 insertions(+), 28 deletions(-) create mode 100644 Emulsion.Tests/TestUtils/TelegramClientMock.fs diff --git a/Emulsion.Telegram/Client.fs b/Emulsion.Telegram/Client.fs index 2f2d708b..74546d7c 100644 --- a/Emulsion.Telegram/Client.fs +++ b/Emulsion.Telegram/Client.fs @@ -1,11 +1,15 @@ namespace Emulsion.Telegram +open System open System.Threading open Emulsion.Database open Emulsion.Messaging.MessageSystem open Emulsion.Settings +type ITelegramClient = + abstract GetTemporaryFileLink: fileId: string -> Async + type Client(ctx: ServiceContext, cancellationToken: CancellationToken, telegramSettings: TelegramSettings, @@ -15,10 +19,16 @@ type Client(ctx: ServiceContext, let botConfig = { Funogram.Telegram.Bot.Config.defaultConfig with Token = telegramSettings.Token } + interface ITelegramClient with + member this.GetTemporaryFileLink(fileId) = async { + let! file = Funogram.sendGetFile botConfig fileId + return file.FilePath |> Option.map(fun fp -> Uri (failwith "Invalid: public file link is impossible to generate")) + } + override _.RunUntilError receiver = async { // Run loop of Telegram is in no need of any complicated start, so just return an async that will perform it: return Funogram.run ctx.Logger telegramSettings databaseSettings hostingSettings botConfig receiver } override _.Send message = - Funogram.send telegramSettings botConfig message + Funogram.sendMessage telegramSettings botConfig message diff --git a/Emulsion.Telegram/Funogram.fs b/Emulsion.Telegram/Funogram.fs index a9edad6c..aadf6ae1 100644 --- a/Emulsion.Telegram/Funogram.fs +++ b/Emulsion.Telegram/Funogram.fs @@ -298,9 +298,9 @@ module MessageConverter = else extractMessageContent replyTo links.ReplyToContentLinks { main = mainMessage; replyTo = Some replyToMessage } -let internal processSendResult(result: Result<'a, ApiResponseError>): unit = +let internal processSendResult(result: Result<'a, ApiResponseError>): 'a = match result with - | Ok _ -> () + | Ok x -> x | Error e -> failwith $"Telegram API Call processing error {e.ErrorCode}: {e.Description}" @@ -347,15 +347,23 @@ let internal prepareHtmlMessage: Message -> string = function | Authored {author = author; text = text} -> $"{Html.escape author}\n{Html.escape text}" | Event {text = text} -> Html.escape text -let send (settings: TelegramSettings) (botConfig: BotConfig) (OutgoingMessage content): Async = +let private send (botConfig: BotConfig) request = api botConfig request + +let sendGetFile (botConfig: BotConfig) (fileId: string): Async = async { + let! result = send botConfig (Req.GetFile.Make fileId) + return processSendResult result +} + +let sendMessage (settings: TelegramSettings) (botConfig: BotConfig) (OutgoingMessage content): Async = let sendHtmlMessage (groupId: ChatId) text = Req.SendMessage.Make(groupId, text, ParseMode.HTML) let groupId = Int(int64 settings.GroupId) let message = prepareHtmlMessage content async { - let! result = api botConfig (sendHtmlMessage groupId message) - return processSendResult result + let! result = send botConfig (sendHtmlMessage groupId message) + processSendResult result |> ignore + return () } let run (logger: ILogger) diff --git a/Emulsion.Tests/Emulsion.Tests.fsproj b/Emulsion.Tests/Emulsion.Tests.fsproj index bcb0b36e..eb8484b0 100644 --- a/Emulsion.Tests/Emulsion.Tests.fsproj +++ b/Emulsion.Tests/Emulsion.Tests.fsproj @@ -9,6 +9,7 @@ + diff --git a/Emulsion.Tests/TestUtils/TelegramClientMock.fs b/Emulsion.Tests/TestUtils/TelegramClientMock.fs new file mode 100644 index 00000000..926ba67d --- /dev/null +++ b/Emulsion.Tests/TestUtils/TelegramClientMock.fs @@ -0,0 +1,15 @@ +namespace Emulsion.Tests.TestUtils + +open System +open System.Collections.Generic + +open Emulsion.Telegram + +type TelegramClientMock() = + let responses = Dictionary() + + interface ITelegramClient with + member this.GetTemporaryFileLink fileId = async.Return responses[fileId] + + member _.SetResponse(fileId: string, uri: Uri): unit = + responses[fileId] <- uri diff --git a/Emulsion.Tests/Web/ContentControllerTests.fs b/Emulsion.Tests/Web/ContentControllerTests.fs index ccad1970..700c9eff 100644 --- a/Emulsion.Tests/Web/ContentControllerTests.fs +++ b/Emulsion.Tests/Web/ContentControllerTests.fs @@ -26,6 +26,7 @@ type ContentControllerTests(output: ITestOutputHelper) = } let logger = xunitLogger output + let telegramClient = TelegramClientMock() let performTestWithPreparation prepareAction testAction = Async.StartAsTask(async { return! TestDataStorage.doWithDatabase(fun databaseSettings -> async { @@ -34,7 +35,7 @@ type ContentControllerTests(output: ITestOutputHelper) = use loggerFactory = new SerilogLoggerFactory(logger) let logger = loggerFactory.CreateLogger() use context = new EmulsionDbContext(databaseSettings.ContextOptions) - let controller = ContentController(logger, hostingSettings, context) + let controller = ContentController(logger, hostingSettings, telegramClient, context) return! testAction controller }) }) @@ -62,6 +63,11 @@ type ContentControllerTests(output: ITestOutputHelper) = let contentId = 343L let chatUserName = "MySuperExampleChat" let messageId = 777L + let fileId = "foobar" + + let testLink = Uri "https://example.com/myFile" + telegramClient.SetResponse(fileId, testLink) + performTestWithPreparation (fun databaseOptions -> async { use context = new EmulsionDbContext(databaseOptions.ContextOptions) let content = { @@ -76,5 +82,5 @@ type ContentControllerTests(output: ITestOutputHelper) = let hashId = Proxy.encodeHashId hostingSettings.HashIdSalt contentId let! result = Async.AwaitTask <| controller.Get hashId let redirect = Assert.IsType result - Assert.Equal($"https://t.me/{chatUserName}/{string messageId}", redirect.Url) + Assert.Equal(testLink, Uri redirect.Url) }) diff --git a/Emulsion.Web/ContentController.fs b/Emulsion.Web/ContentController.fs index a7b1552a..17ffa329 100644 --- a/Emulsion.Web/ContentController.fs +++ b/Emulsion.Web/ContentController.fs @@ -2,6 +2,8 @@ open System.Threading.Tasks +open Emulsion.Database.Entities +open Emulsion.Telegram open Microsoft.AspNetCore.Mvc open Microsoft.Extensions.Logging @@ -13,6 +15,7 @@ open Emulsion.Settings [] type ContentController(logger: ILogger, configuration: HostingSettings, + telegram: ITelegramClient, context: EmulsionDbContext) = inherit ControllerBase() @@ -26,12 +29,11 @@ type ContentController(logger: ILogger, let produceRedirect contentId: Async = async { let! content = ContentStorage.getById context contentId - return - content - |> Option.map(fun c -> - let url = $"https://t.me/{c.ChatUserName}/{string c.MessageId}" - RedirectResult url - ) + match content with + | Some content -> + let! url = telegram.GetTemporaryFileLink content.FileId + return Some <| RedirectResult(url.ToString()) + | None -> return None } [] diff --git a/Emulsion.Web/Emulsion.Web.fsproj b/Emulsion.Web/Emulsion.Web.fsproj index eb58afb6..569840ec 100644 --- a/Emulsion.Web/Emulsion.Web.fsproj +++ b/Emulsion.Web/Emulsion.Web.fsproj @@ -12,6 +12,7 @@ + diff --git a/Emulsion.Web/WebServer.fs b/Emulsion.Web/WebServer.fs index a8504922..b015c557 100644 --- a/Emulsion.Web/WebServer.fs +++ b/Emulsion.Web/WebServer.fs @@ -2,13 +2,19 @@ module Emulsion.Web.WebServer open System.Threading.Tasks -open Emulsion.Database -open Emulsion.Settings open Microsoft.AspNetCore.Builder open Microsoft.Extensions.DependencyInjection open Serilog -let run (logger: ILogger) (hostingSettings: HostingSettings) (databaseSettings: DatabaseSettings): Task = +open Emulsion.Database +open Emulsion.Settings +open Emulsion.Telegram + +let run (logger: ILogger) + (hostingSettings: HostingSettings) + (databaseSettings: DatabaseSettings) + (telegram: ITelegramClient) + : Task = let builder = WebApplication.CreateBuilder(WebApplicationOptions()) builder.Host.UseSerilog(logger) @@ -16,6 +22,7 @@ let run (logger: ILogger) (hostingSettings: HostingSettings) (databaseSettings: builder.Services .AddSingleton(hostingSettings) + .AddSingleton(telegram) .AddTransient(fun _ -> new EmulsionDbContext(databaseSettings.ContextOptions)) .AddControllers() .AddApplicationPart(typeof.Assembly) diff --git a/Emulsion.sln.DotSettings b/Emulsion.sln.DotSettings index 4aa17b0b..a93531a6 100644 --- a/Emulsion.sln.DotSettings +++ b/Emulsion.sln.DotSettings @@ -1,5 +1,6 @@  True + True True True True diff --git a/Emulsion/Program.fs b/Emulsion/Program.fs index 8b721c08..c49295e3 100644 --- a/Emulsion/Program.fs +++ b/Emulsion/Program.fs @@ -47,6 +47,17 @@ let private startApp config = async { let logger = Logging.createRootLogger config.Log try + let xmppLogger = Logging.xmppLogger logger + let telegramLogger = Logging.telegramLogger logger + + let! cancellationToken = Async.CancellationToken + let xmpp = XmppMessageSystem(serviceContext xmppLogger, cancellationToken, config.Xmpp) + let telegram = Telegram.Client(serviceContext telegramLogger, + cancellationToken, + config.Telegram, + config.Database, + config.Hosting) + match config.Database with | Some dbSettings -> do! migrateDatabase logger dbSettings | None -> () @@ -55,23 +66,13 @@ let private startApp config = match config.Hosting, config.Database with | Some hosting, Some database -> logger.Information "Initializing web server…" - Some <| WebServer.run logger hosting database + Some <| WebServer.run logger hosting database telegram | _ -> None logger.Information "Actor system preparation…" use system = ActorSystem.Create("emulsion") logger.Information "Clients preparation…" - let xmppLogger = Logging.xmppLogger logger - let telegramLogger = Logging.telegramLogger logger - - let! cancellationToken = Async.CancellationToken - let xmpp = XmppMessageSystem(serviceContext xmppLogger, cancellationToken, config.Xmpp) - let telegram = Telegram.Client(serviceContext telegramLogger, - cancellationToken, - config.Telegram, - config.Database, - config.Hosting) let factories = { xmppFactory = Xmpp.spawn xmppLogger xmpp telegramFactory = Telegram.spawn telegramLogger telegram } logger.Information "Core preparation…" From afbe2f85c21f2e3cbaef468e01dc16fd30e9602d Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sun, 7 Aug 2022 21:45:05 +0200 Subject: [PATCH 02/23] (#102) ContentProxy: add a FileCache --- .../Emulsion.ContentProxy.fsproj | 3 + Emulsion.ContentProxy/FileCache.fs | 109 ++++++++++++++++++ Emulsion.Settings/Settings.fs | 21 +++- Emulsion.Telegram/Client.fs | 17 ++- Emulsion.Tests/ContentProxy/FileCacheTests.fs | 20 ++++ Emulsion.Tests/Emulsion.Tests.fsproj | 1 + README.md | 18 ++- emulsion.example.json | 3 +- 8 files changed, 182 insertions(+), 10 deletions(-) create mode 100644 Emulsion.ContentProxy/FileCache.fs create mode 100644 Emulsion.Tests/ContentProxy/FileCacheTests.fs diff --git a/Emulsion.ContentProxy/Emulsion.ContentProxy.fsproj b/Emulsion.ContentProxy/Emulsion.ContentProxy.fsproj index 3de8d6cb..8a528a74 100644 --- a/Emulsion.ContentProxy/Emulsion.ContentProxy.fsproj +++ b/Emulsion.ContentProxy/Emulsion.ContentProxy.fsproj @@ -7,14 +7,17 @@ + + + diff --git a/Emulsion.ContentProxy/FileCache.fs b/Emulsion.ContentProxy/FileCache.fs new file mode 100644 index 00000000..dd88f510 --- /dev/null +++ b/Emulsion.ContentProxy/FileCache.fs @@ -0,0 +1,109 @@ +namespace Emulsion.ContentProxy + +open System +open System.IO +open System.Security.Cryptography +open System.Text + +open System.Threading +open Emulsion.Settings +open Serilog + +type DownloadRequest = { + Uri: Uri + CacheKey: string + Size: uint64 + ReplyChannel: AsyncReplyChannel +} + +// TODO: Total cache limit +// TODO: Threading +type FileCache(logger: ILogger, + settings: FileCacheSettings, + sha256: SHA256) = + + let getFilePath (cacheKey: string) = + let hash = + cacheKey + |> Encoding.UTF8.GetBytes + |> sha256.ComputeHash + |> Convert.ToBase64String + Path.Combine(settings.Directory, hash) + + let getFromCache(cacheKey: string) = async { + let path = getFilePath cacheKey + do! Async.SwitchToThreadPool() + return + if File.Exists path then + Some(new FileStream(path, FileMode.Open, FileAccess.Read, FileShare.Delete)) + else + None + } + + // TODO: Check total item size, too + let ensureFreeCache size = async { + if size > settings.FileSizeLimitBytes then + return false + else + return failwith "TODO: Sanity check that cache only has files" + } + + let download uri: Async = async { + return failwithf "TODO: Download the URI and return a stream" + } + + let downloadIntoCacheAndGet uri cacheKey: Async = async { + let! stream = download uri + let path = getFilePath cacheKey + logger.Information("Saving {Uri} to path {Path}…", uri, path) + + do! Async.SwitchToThreadPool() + use cachedFile = new FileStream(path, FileMode.Open, FileAccess.Write, FileShare.None) + do! Async.AwaitTask(stream.CopyToAsync cachedFile) + + match! getFromCache cacheKey with + | Some + + } + + let cancellation = new CancellationTokenSource() + let processRequest request = async { + logger.Information("Cache lookup for content {Uri} (cache key {CacheKey})", uri, cacheKey) + match! getFromCache cacheKey with + | Some content -> + logger.Information("Cache hit for content {Uri} (cache key {CacheKey})", uri, cacheKey) + return Some content + | None -> + logger.Information("No cache hit for content {Uri} (cache key {CacheKey}), will download", uri, cacheKey) + let! shouldCache = ensureFreeCache size + if shouldCache then + logger.Information("Resource {Uri} (cache key {CacheKey}, {Size} bytes) will fit into cache, caching", uri, cacheKey, size) + let! result = downloadIntoCacheAndGet uri cacheKey + logger.Information("Resource {Uri} (cache key {CacheKey}, {Size} bytes) downloaded", uri, cacheKey, size) + return Some result + else + logger.Information("Resource {Uri} (cache key {CacheKey}) won't fit into cache, directly downloading", uri, cacheKey) + let! result = download uri + return Some result + } + let rec processLoop (processor: MailboxProcessor<_>) = async { + while true do + try + let! message = processor.Re() + do! processRequest message processor + with + | ex -> logger.Error(ex, "Exception while processing the file download queue") + } + let processor = MailboxProcessor.Start(processLoop, cancellation.Token) + + interface IDisposable with + member _.Dispose() = + cancellation.Dispose() + (processor :> IDisposable).Dispose() + + member _.DownloadLink(uri: Uri, cacheKey: string, size: uint64): Async = processor.PostAndReply(fun chan -> { + Uri = uri + CacheKey = cacheKey + Size = size + ReplyChannel = chan + }) diff --git a/Emulsion.Settings/Settings.fs b/Emulsion.Settings/Settings.fs index 9832e22d..ccdd130d 100644 --- a/Emulsion.Settings/Settings.fs +++ b/Emulsion.Settings/Settings.fs @@ -34,12 +34,18 @@ type HostingSettings = { HashIdSalt: string } +type FileCacheSettings = { + Directory: string + FileSizeLimitBytes: uint64 +} + type EmulsionSettings = { Xmpp: XmppSettings Telegram: TelegramSettings Log: LogSettings Database: DatabaseSettings option Hosting: HostingSettings option + FileCache: FileCacheSettings option } let defaultConnectionTimeout = TimeSpan.FromMinutes 5.0 @@ -56,6 +62,12 @@ let private readTimeSpan defaultVal key section = |> Option.defaultValue defaultVal let read (config : IConfiguration) : EmulsionSettings = + let uint64OrDefault value ``default`` = + value + |> Option.ofObj + |> Option.map uint64 + |> Option.defaultValue ``default`` + let readXmpp (section : IConfigurationSection) = { Login = section["login"] Password = section["password"] @@ -91,9 +103,16 @@ let read (config : IConfiguration) : EmulsionSettings = } | None, None, None -> None | other -> failwith $"Parameter pack {other} represents invalid hosting settings." + let readFileCache(section: IConfigurationSection) = + Option.ofObj section["directory"] + |> Option.map(fun directory -> { + Directory = directory + FileSizeLimitBytes = uint64OrDefault section["fileSizeLimitBytes"] 1048576UL + }) { Xmpp = readXmpp <| config.GetSection("xmpp") Telegram = readTelegram <| config.GetSection("telegram") Log = readLog <| config.GetSection "log" Database = readDatabase <| config.GetSection "database" - Hosting = readHosting <| config.GetSection "hosting" } + Hosting = readHosting <| config.GetSection "hosting" + FileCache = readFileCache <| config.GetSection "fileCache" } diff --git a/Emulsion.Telegram/Client.fs b/Emulsion.Telegram/Client.fs index 74546d7c..df635f0d 100644 --- a/Emulsion.Telegram/Client.fs +++ b/Emulsion.Telegram/Client.fs @@ -1,28 +1,39 @@ namespace Emulsion.Telegram open System +open System.IO open System.Threading +open Emulsion.ContentProxy open Emulsion.Database open Emulsion.Messaging.MessageSystem open Emulsion.Settings type ITelegramClient = - abstract GetTemporaryFileLink: fileId: string -> Async + abstract GetTemporaryFileLink: fileId: string -> Async type Client(ctx: ServiceContext, cancellationToken: CancellationToken, telegramSettings: TelegramSettings, databaseSettings: DatabaseSettings option, - hostingSettings: HostingSettings option) = + hostingSettings: HostingSettings option, + fileCache: FileCache option) = inherit MessageSystemBase(ctx, cancellationToken) let botConfig = { Funogram.Telegram.Bot.Config.defaultConfig with Token = telegramSettings.Token } interface ITelegramClient with member this.GetTemporaryFileLink(fileId) = async { + let logger = ctx.Logger + logger.Information("Querying file information for file {FileId}", fileId) let! file = Funogram.sendGetFile botConfig fileId - return file.FilePath |> Option.map(fun fp -> Uri (failwith "Invalid: public file link is impossible to generate")) + match file.FilePath with + | None -> + logger.Warning("File {FileId} was not found on server", fileId) + return None + | Some fp -> + let uri = Uri $"https://api.telegram.org/file/bot{telegramSettings.Token}/{fp}" + return! fileCache.DownloadLink uri } override _.RunUntilError receiver = async { diff --git a/Emulsion.Tests/ContentProxy/FileCacheTests.fs b/Emulsion.Tests/ContentProxy/FileCacheTests.fs new file mode 100644 index 00000000..33df4ae5 --- /dev/null +++ b/Emulsion.Tests/ContentProxy/FileCacheTests.fs @@ -0,0 +1,20 @@ +namespace Emulsion.Tests.ContentProxy + +open Xunit +open Xunit.Abstractions + +type FileCacheTests(outputHelper: ITestOutputHelper) = + member _.``File should be cached``(): unit = + Assert.False true + + member _.``Too big file should be proxied``(): unit = + Assert.False true + + member _.``Cleanup should be triggered``(): unit = + Assert.False true + + member _.``File should be read even after cleanup``(): unit = + Assert.False true + + member _.``File should be re-downloaded after cleanup even if there's a outdated read session in progress``(): unit = + Assert.False true diff --git a/Emulsion.Tests/Emulsion.Tests.fsproj b/Emulsion.Tests/Emulsion.Tests.fsproj index eb8484b0..a7b2fd62 100644 --- a/Emulsion.Tests/Emulsion.Tests.fsproj +++ b/Emulsion.Tests/Emulsion.Tests.fsproj @@ -33,6 +33,7 @@ + diff --git a/README.md b/README.md index 6023e63c..9a8512c1 100644 --- a/README.md +++ b/README.md @@ -15,8 +15,7 @@ $ dotnet build Configure --------- -Copy `emulsion.example.json` to `emulsion.json` and set the settings. For some -settings, there're defaults: +Copy `emulsion.example.json` to `emulsion.json` and set the settings. For some settings, there are defaults: ```json { @@ -26,19 +25,22 @@ settings, there're defaults: "messageTimeout": "00:05:00", "pingInterval": null, "pingTimeout": "00:00:30" + }, + "fileCache": { + "fileSizeLimitBytes": 1048576 } } ``` -All the other settings are required, except the `database` and `hosting` sections. +All the other settings are required, except the `database`, `hosting` and `fileCache` sections (the corresponding functionality will be turned off if the sections aren't filled). Note that `pingInterval` of `null` disables XMPP ping support. ### Telegram Content Proxy -There's **unfinished** Telegram content proxy support, for XMPP users to access Telegram content without directly opening links on t.me. Right now, it will only generate a redirect to the corresponding t.me URI, so it doesn't help a lot. But in the future, proper content proxy will be supported. +There's Telegram content proxy support, for XMPP users to access Telegram content without directly opening links on t.me. -To enable it, configure the `database` and `hosting` configuration file sections: +To enable it, configure the `database`, `hosting` and `fileCache` configuration file sections: ```json { @@ -49,6 +51,10 @@ To enable it, configure the `database` and `hosting` configuration file sections "externalUriBase": "https://example.com/api/", "bindUri": "http://*:5000/", "hashIdSalt": "test" + }, + "fileCache": { + "directory": "/tmp/emulsion/cache", + "fileSizeLimitBytes": 1048576 } } ``` @@ -61,6 +67,8 @@ If all the parameters are set, then Emulsion will save the incoming messages int The content identifiers in question are generated from the database ones using the [hashids.net][hashids.net] library, `hashIdSalt` is used in generation. This should complicate guessing of content ids for any external party not reading the chat directly. +If the `fileCache.directory` option is not set, then the content proxy will only generate redirects to corresponding t.me URIs. Otherwise, it will store the downloaded files (that fit the cache) in a cache on disk; the items not fitting into the cache will be proxied to clients. + ### Recommended Network Configuration Current configuration system allows the following: diff --git a/emulsion.example.json b/emulsion.example.json index 7ee1ca5b..a7b24ad8 100644 --- a/emulsion.example.json +++ b/emulsion.example.json @@ -24,5 +24,6 @@ "externalUriBase": "https://example.com/api/", "bindUri": "http://*:5000", "hashIdSalt": "test" - } + }, + "fileCache": {} } From 800546aa01a917005f40a9fd219e1a13ad3b07b4 Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sat, 20 Aug 2022 21:19:41 +0200 Subject: [PATCH 03/23] (#102) ContentProxy: finally, make it compile --- Emulsion.ContentProxy/FileCache.fs | 58 +++++++++---------- Emulsion.Telegram/Client.fs | 27 +++++---- Emulsion.Tests/SettingsTests.fs | 1 + .../TestUtils/TelegramClientMock.fs | 9 ++- Emulsion.Tests/Web/ContentControllerTests.fs | 9 ++- Emulsion.Web/ContentController.fs | 42 +++++++++----- 6 files changed, 84 insertions(+), 62 deletions(-) diff --git a/Emulsion.ContentProxy/FileCache.fs b/Emulsion.ContentProxy/FileCache.fs index dd88f510..cf07f4db 100644 --- a/Emulsion.ContentProxy/FileCache.fs +++ b/Emulsion.ContentProxy/FileCache.fs @@ -13,11 +13,9 @@ type DownloadRequest = { Uri: Uri CacheKey: string Size: uint64 - ReplyChannel: AsyncReplyChannel } // TODO: Total cache limit -// TODO: Threading type FileCache(logger: ILogger, settings: FileCacheSettings, sha256: SHA256) = @@ -32,7 +30,6 @@ type FileCache(logger: ILogger, let getFromCache(cacheKey: string) = async { let path = getFilePath cacheKey - do! Async.SwitchToThreadPool() return if File.Exists path then Some(new FileStream(path, FileMode.Open, FileAccess.Read, FileShare.Delete)) @@ -53,46 +50,49 @@ type FileCache(logger: ILogger, } let downloadIntoCacheAndGet uri cacheKey: Async = async { + let! ct = Async.CancellationToken let! stream = download uri let path = getFilePath cacheKey logger.Information("Saving {Uri} to path {Path}…", uri, path) - do! Async.SwitchToThreadPool() use cachedFile = new FileStream(path, FileMode.Open, FileAccess.Write, FileShare.None) - do! Async.AwaitTask(stream.CopyToAsync cachedFile) - - match! getFromCache cacheKey with - | Some + do! Async.AwaitTask(stream.CopyToAsync(cachedFile, ct)) + let! file = getFromCache cacheKey + return upcast Option.get file } let cancellation = new CancellationTokenSource() - let processRequest request = async { - logger.Information("Cache lookup for content {Uri} (cache key {CacheKey})", uri, cacheKey) - match! getFromCache cacheKey with + let processRequest request: Async = async { + logger.Information("Cache lookup for content {Uri} (cache key {CacheKey})", request.Uri, request.CacheKey) + match! getFromCache request.CacheKey with | Some content -> - logger.Information("Cache hit for content {Uri} (cache key {CacheKey})", uri, cacheKey) + logger.Information("Cache hit for content {Uri} (cache key {CacheKey})", request.Uri, request.CacheKey) return Some content | None -> - logger.Information("No cache hit for content {Uri} (cache key {CacheKey}), will download", uri, cacheKey) - let! shouldCache = ensureFreeCache size + logger.Information("No cache hit for content {Uri} (cache key {CacheKey}), will download", request.Uri, request.CacheKey) + let! shouldCache = ensureFreeCache request.Size if shouldCache then - logger.Information("Resource {Uri} (cache key {CacheKey}, {Size} bytes) will fit into cache, caching", uri, cacheKey, size) - let! result = downloadIntoCacheAndGet uri cacheKey - logger.Information("Resource {Uri} (cache key {CacheKey}, {Size} bytes) downloaded", uri, cacheKey, size) + logger.Information("Resource {Uri} (cache key {CacheKey}, {Size} bytes) will fit into cache, caching", request.Uri, request.CacheKey, request.Size) + let! result = downloadIntoCacheAndGet request.Uri request.CacheKey + logger.Information("Resource {Uri} (cache key {CacheKey}, {Size} bytes) downloaded", request.Uri, request.CacheKey, request.Size) return Some result else - logger.Information("Resource {Uri} (cache key {CacheKey}) won't fit into cache, directly downloading", uri, cacheKey) - let! result = download uri + logger.Information("Resource {Uri} (cache key {CacheKey}) won't fit into cache, directly downloading", request.Uri, request.CacheKey) + let! result = download request.Uri return Some result } - let rec processLoop (processor: MailboxProcessor<_>) = async { + + let rec processLoop(processor: MailboxProcessor<_ * AsyncReplyChannel<_>>) = async { while true do + let! request, replyChannel = processor.Receive() try - let! message = processor.Re() - do! processRequest message processor + let! result = processRequest request + replyChannel.Reply result with - | ex -> logger.Error(ex, "Exception while processing the file download queue") + | ex -> + logger.Error(ex, "Exception while processing the file download queue") + replyChannel.Reply None } let processor = MailboxProcessor.Start(processLoop, cancellation.Token) @@ -101,9 +101,9 @@ type FileCache(logger: ILogger, cancellation.Dispose() (processor :> IDisposable).Dispose() - member _.DownloadLink(uri: Uri, cacheKey: string, size: uint64): Async = processor.PostAndReply(fun chan -> { - Uri = uri - CacheKey = cacheKey - Size = size - ReplyChannel = chan - }) + member _.Download(uri: Uri, cacheKey: string, size: uint64): Async = + processor.PostAndAsyncReply(fun chan -> ({ + Uri = uri + CacheKey = cacheKey + Size = size + }, chan)) diff --git a/Emulsion.Telegram/Client.fs b/Emulsion.Telegram/Client.fs index df635f0d..459874d8 100644 --- a/Emulsion.Telegram/Client.fs +++ b/Emulsion.Telegram/Client.fs @@ -1,39 +1,44 @@ namespace Emulsion.Telegram open System -open System.IO open System.Threading -open Emulsion.ContentProxy open Emulsion.Database open Emulsion.Messaging.MessageSystem open Emulsion.Settings +type FileInfo = { + TemporaryLink: Uri + Size: uint64 +} + type ITelegramClient = - abstract GetTemporaryFileLink: fileId: string -> Async + abstract GetFileInfo: fileId: string -> Async type Client(ctx: ServiceContext, cancellationToken: CancellationToken, telegramSettings: TelegramSettings, databaseSettings: DatabaseSettings option, - hostingSettings: HostingSettings option, - fileCache: FileCache option) = + hostingSettings: HostingSettings option) = inherit MessageSystemBase(ctx, cancellationToken) let botConfig = { Funogram.Telegram.Bot.Config.defaultConfig with Token = telegramSettings.Token } interface ITelegramClient with - member this.GetTemporaryFileLink(fileId) = async { + member this.GetFileInfo(fileId) = async { let logger = ctx.Logger logger.Information("Querying file information for file {FileId}", fileId) let! file = Funogram.sendGetFile botConfig fileId - match file.FilePath with - | None -> + match file.FilePath, file.FileSize with + | None, None -> logger.Warning("File {FileId} was not found on server", fileId) return None - | Some fp -> - let uri = Uri $"https://api.telegram.org/file/bot{telegramSettings.Token}/{fp}" - return! fileCache.DownloadLink uri + | Some fp, Some sz -> + return Some { + TemporaryLink = Uri $"https://api.telegram.org/file/bot{telegramSettings.Token}/{fp}" + Size = Checked.uint64 sz + } + | x, y -> return failwith $"Unknown data received from Telegram server: {x}, {y}" } override _.RunUntilError receiver = async { diff --git a/Emulsion.Tests/SettingsTests.fs b/Emulsion.Tests/SettingsTests.fs index 4f80a9a2..57b05769 100644 --- a/Emulsion.Tests/SettingsTests.fs +++ b/Emulsion.Tests/SettingsTests.fs @@ -50,6 +50,7 @@ let private testConfiguration = { } Database = None Hosting = None + FileCache = None } let private mockConfiguration groupIdLiteral extendedJson = diff --git a/Emulsion.Tests/TestUtils/TelegramClientMock.fs b/Emulsion.Tests/TestUtils/TelegramClientMock.fs index 926ba67d..f02c1064 100644 --- a/Emulsion.Tests/TestUtils/TelegramClientMock.fs +++ b/Emulsion.Tests/TestUtils/TelegramClientMock.fs @@ -1,15 +1,14 @@ namespace Emulsion.Tests.TestUtils -open System open System.Collections.Generic open Emulsion.Telegram type TelegramClientMock() = - let responses = Dictionary() + let responses = Dictionary() interface ITelegramClient with - member this.GetTemporaryFileLink fileId = async.Return responses[fileId] + member this.GetFileInfo fileId = async.Return responses[fileId] - member _.SetResponse(fileId: string, uri: Uri): unit = - responses[fileId] <- uri + member _.SetResponse(fileId: string, fileInfo: FileInfo option): unit = + responses[fileId] <- fileInfo diff --git a/Emulsion.Tests/Web/ContentControllerTests.fs b/Emulsion.Tests/Web/ContentControllerTests.fs index 700c9eff..da119697 100644 --- a/Emulsion.Tests/Web/ContentControllerTests.fs +++ b/Emulsion.Tests/Web/ContentControllerTests.fs @@ -13,6 +13,7 @@ open Emulsion.ContentProxy open Emulsion.Database open Emulsion.Database.Entities open Emulsion.Settings +open Emulsion.Telegram open Emulsion.Tests.TestUtils open Emulsion.Tests.TestUtils.Logging open Emulsion.Web @@ -35,7 +36,7 @@ type ContentControllerTests(output: ITestOutputHelper) = use loggerFactory = new SerilogLoggerFactory(logger) let logger = loggerFactory.CreateLogger() use context = new EmulsionDbContext(databaseSettings.ContextOptions) - let controller = ContentController(logger, hostingSettings, telegramClient, context) + let controller = ContentController(logger, hostingSettings, telegramClient, None, context) return! testAction controller }) }) @@ -66,7 +67,11 @@ type ContentControllerTests(output: ITestOutputHelper) = let fileId = "foobar" let testLink = Uri "https://example.com/myFile" - telegramClient.SetResponse(fileId, testLink) + let testFileInfo = { + TemporaryLink = testLink + Size = 1UL + } + telegramClient.SetResponse(fileId, Some testFileInfo) performTestWithPreparation (fun databaseOptions -> async { use context = new EmulsionDbContext(databaseOptions.ContextOptions) diff --git a/Emulsion.Web/ContentController.fs b/Emulsion.Web/ContentController.fs index 17ffa329..e7a0bbe2 100644 --- a/Emulsion.Web/ContentController.fs +++ b/Emulsion.Web/ContentController.fs @@ -2,20 +2,21 @@ open System.Threading.Tasks -open Emulsion.Database.Entities -open Emulsion.Telegram open Microsoft.AspNetCore.Mvc open Microsoft.Extensions.Logging open Emulsion.ContentProxy open Emulsion.Database +open Emulsion.Database.Entities open Emulsion.Settings +open Emulsion.Telegram [] [] type ContentController(logger: ILogger, configuration: HostingSettings, telegram: ITelegramClient, + fileCache: FileCache option, context: EmulsionDbContext) = inherit ControllerBase() @@ -27,21 +28,32 @@ type ContentController(logger: ILogger, logger.LogWarning(ex, "Error during hashId deserializing") None - let produceRedirect contentId: Async = async { - let! content = ContentStorage.getById context contentId - match content with - | Some content -> - let! url = telegram.GetTemporaryFileLink content.FileId - return Some <| RedirectResult(url.ToString()) - | None -> return None - } - [] member this.Get(hashId: string): Task = task { match decodeHashId hashId with - | None -> return this.BadRequest() + | None -> + logger.LogWarning $"Cannot decode hash id: \"{hashId}\"." + return this.BadRequest() | Some contentId -> - match! produceRedirect contentId with - | None -> return this.NotFound() :> IActionResult - | Some redirect -> return redirect + match! ContentStorage.getById context contentId with + | None -> + logger.LogWarning $"Content \"{contentId}\" not found in content storage." + return this.NotFound() :> IActionResult + | Some content -> + match fileCache with + | None -> + let link = $"https://t.me/{content.ChatUserName}/{string content.MessageId}" + return RedirectResult link + | Some cache -> + match! telegram.GetFileInfo content.FileId with + | None -> + logger.LogWarning $"File \"{content.FileId}\" could not be found on Telegram server." + return this.NotFound() :> IActionResult + | Some fileInfo -> + match! cache.Download(fileInfo.TemporaryLink, content.FileId, fileInfo.Size) with + | None -> + logger.LogWarning $"Link \"{fileInfo}\" could not be downloaded." + return this.NotFound() :> IActionResult + | Some stream -> + return FileStreamResult(stream, "application/octet-stream") } From 3e7b42240a8aa864cc2efa311896fd473f097006 Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sat, 20 Aug 2022 22:00:18 +0200 Subject: [PATCH 04/23] (#102) FileCacheTests: preliminary test API --- Emulsion.ContentProxy/FileCache.fs | 17 ++-- Emulsion.Settings/Settings.fs | 4 +- Emulsion.Tests/ContentProxy/FileCacheTests.fs | 80 ++++++++++++++++++- Emulsion.Tests/Emulsion.Tests.fsproj | 1 + Emulsion.Tests/TestUtils/WebFileStorage.fs | 14 ++++ README.md | 6 +- 6 files changed, 110 insertions(+), 12 deletions(-) create mode 100644 Emulsion.Tests/TestUtils/WebFileStorage.fs diff --git a/Emulsion.ContentProxy/FileCache.fs b/Emulsion.ContentProxy/FileCache.fs index cf07f4db..6159dd8e 100644 --- a/Emulsion.ContentProxy/FileCache.fs +++ b/Emulsion.ContentProxy/FileCache.fs @@ -15,18 +15,20 @@ type DownloadRequest = { Size: uint64 } +module FileCache = + let FileName(sha256: SHA256, cacheKey: string): string = + cacheKey + |> Encoding.UTF8.GetBytes + |> sha256.ComputeHash + |> Convert.ToBase64String + // TODO: Total cache limit type FileCache(logger: ILogger, settings: FileCacheSettings, sha256: SHA256) = - let getFilePath (cacheKey: string) = - let hash = - cacheKey - |> Encoding.UTF8.GetBytes - |> sha256.ComputeHash - |> Convert.ToBase64String - Path.Combine(settings.Directory, hash) + let getFilePath(cacheKey: string) = + Path.Combine(settings.Directory, FileCache.FileName(sha256, cacheKey)) let getFromCache(cacheKey: string) = async { let path = getFilePath cacheKey @@ -57,6 +59,7 @@ type FileCache(logger: ILogger, use cachedFile = new FileStream(path, FileMode.Open, FileAccess.Write, FileShare.None) do! Async.AwaitTask(stream.CopyToAsync(cachedFile, ct)) + logger.Information("Download successful: \"{Uri}\" to \"{Path}\".") let! file = getFromCache cacheKey return upcast Option.get file diff --git a/Emulsion.Settings/Settings.fs b/Emulsion.Settings/Settings.fs index ccdd130d..db034f20 100644 --- a/Emulsion.Settings/Settings.fs +++ b/Emulsion.Settings/Settings.fs @@ -37,6 +37,7 @@ type HostingSettings = { type FileCacheSettings = { Directory: string FileSizeLimitBytes: uint64 + TotalCacheSizeLimitBytes: uint64 } type EmulsionSettings = { @@ -107,7 +108,8 @@ let read (config : IConfiguration) : EmulsionSettings = Option.ofObj section["directory"] |> Option.map(fun directory -> { Directory = directory - FileSizeLimitBytes = uint64OrDefault section["fileSizeLimitBytes"] 1048576UL + FileSizeLimitBytes = uint64OrDefault section["fileSizeLimitBytes"] 1024UL * 1024UL + TotalCacheSizeLimitBytes = uint64OrDefault section["fileSizeLimitBytes"] 20UL * 1024UL * 1024UL }) { Xmpp = readXmpp <| config.GetSection("xmpp") diff --git a/Emulsion.Tests/ContentProxy/FileCacheTests.fs b/Emulsion.Tests/ContentProxy/FileCacheTests.fs index 33df4ae5..9baae38d 100644 --- a/Emulsion.Tests/ContentProxy/FileCacheTests.fs +++ b/Emulsion.Tests/ContentProxy/FileCacheTests.fs @@ -1,20 +1,96 @@ namespace Emulsion.Tests.ContentProxy +open System +open System.Collections.Generic +open System.IO +open System.Security.Cryptography +open System.Threading.Tasks + open Xunit open Xunit.Abstractions +open Emulsion.ContentProxy +open Emulsion.Settings +open Emulsion.Tests.TestUtils +open Emulsion.Tests.TestUtils.Logging + type FileCacheTests(outputHelper: ITestOutputHelper) = + + let sha256 = SHA256.Create() + + let cacheDirectory = lazy ( + let path = Path.GetTempFileName() + File.Delete path + Directory.CreateDirectory path |> ignore + path + ) + + let setUpFileCache(totalLimitBytes: uint64) = + let settings = { + Directory = cacheDirectory.Value + FileSizeLimitBytes = 1048576UL + TotalCacheSizeLimitBytes = totalLimitBytes + } + + new FileCache(xunitLogger outputHelper, settings, sha256) + + let assertCacheState(entries: (string * byte[]) seq) = + let files = + Directory.EnumerateFileSystemEntries(cacheDirectory.Value) + |> Seq.map(fun file -> + let name = Path.GetFileName file + let content = File.ReadAllBytes file + name, content + ) + |> Map.ofSeq + + let entries = + entries + |> Seq.map(fun (k, v) -> FileCache.FileName(sha256, k), v) + |> Map.ofSeq + + Assert.Equal>(entries, files) + + [] member _.``File should be cached``(): unit = Assert.False true + [] member _.``Too big file should be proxied``(): unit = Assert.False true - member _.``Cleanup should be triggered``(): unit = - Assert.False true + [] + member _.``Cleanup should be triggered``(): Task = task { + use fileCache = setUpFileCache 129UL + use fileStorage = new WebFileStorage(Map.ofArray [| + "a", [| for _ in 1 .. 128 do yield 1uy |] + "b", [| for _ in 1 .. 128 do yield 2uy |] + "c", [| 3uy |] + |]) + + let! file = fileCache.Download(fileStorage.Link("a"), "a", 128UL) + Assert.True file.IsSome + assertCacheState [| "a", fileStorage.Content("a") |] + let! file = fileCache.Download(fileStorage.Link("b"), "b", 128UL) + Assert.True file.IsSome + assertCacheState [| "b", fileStorage.Content("b") |] + + let! file = fileCache.Download(fileStorage.Link("c"), "c", 1UL) + Assert.True file.IsSome + assertCacheState [| + "b", fileStorage.Content("b") + "c", fileStorage.Content("c") + |] + } + + [] member _.``File should be read even after cleanup``(): unit = Assert.False true + [] member _.``File should be re-downloaded after cleanup even if there's a outdated read session in progress``(): unit = Assert.False true + + interface IDisposable with + member _.Dispose() = sha256.Dispose() diff --git a/Emulsion.Tests/Emulsion.Tests.fsproj b/Emulsion.Tests/Emulsion.Tests.fsproj index a7b2fd62..47821122 100644 --- a/Emulsion.Tests/Emulsion.Tests.fsproj +++ b/Emulsion.Tests/Emulsion.Tests.fsproj @@ -10,6 +10,7 @@ + diff --git a/Emulsion.Tests/TestUtils/WebFileStorage.fs b/Emulsion.Tests/TestUtils/WebFileStorage.fs new file mode 100644 index 00000000..5a859cb3 --- /dev/null +++ b/Emulsion.Tests/TestUtils/WebFileStorage.fs @@ -0,0 +1,14 @@ +namespace Emulsion.Tests.TestUtils + +open System + +type WebFileStorage(data: Map) = + member _.Link(entry: string): Uri = + failwith "todo" + + member _.Content(entry: string): byte[] = + failwith "todo" + + interface IDisposable with + member this.Dispose(): unit = failwith "todo" + diff --git a/README.md b/README.md index 9a8512c1..270b19fa 100644 --- a/README.md +++ b/README.md @@ -27,7 +27,8 @@ Copy `emulsion.example.json` to `emulsion.json` and set the settings. For some s "pingTimeout": "00:00:30" }, "fileCache": { - "fileSizeLimitBytes": 1048576 + "fileSizeLimitBytes": 1048576, + "totalCacheSizeLimitBytes": 20971520 } } ``` @@ -54,7 +55,8 @@ To enable it, configure the `database`, `hosting` and `fileCache` configuration }, "fileCache": { "directory": "/tmp/emulsion/cache", - "fileSizeLimitBytes": 1048576 + "fileSizeLimitBytes": 1048576, + "totalCacheSizeLimitBytes": 20971520 } } ``` From 97db22ad3846716ad5eac654ae27e3e6e17dcbc4 Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sat, 20 Aug 2022 22:18:45 +0200 Subject: [PATCH 05/23] (#102) TestFramework: extract the code from TestUtils --- .../Emulsion.TestFramework.fsproj | 23 +++++++++++++++++++ .../Exceptions.fs | 2 +- .../LockedBuffer.fs | 2 +- .../Logging.fs | 2 +- .../TelegramClientMock.fs | 2 +- .../TestDataStorage.fs | 2 +- .../Waiter.fs | 2 +- .../WebFileStorage.fs | 2 +- Emulsion.Tests/Actors/Core.fs | 2 +- Emulsion.Tests/Actors/Telegram.fs | 2 +- Emulsion.Tests/Actors/Xmpp.fs | 2 +- .../ContentProxy/ContentStorageTests.fs | 2 +- Emulsion.Tests/ContentProxy/FileCacheTests.fs | 4 ++-- .../Database/DatabaseStructureTests.fs | 2 +- Emulsion.Tests/Emulsion.Tests.fsproj | 9 +------- Emulsion.Tests/MessageSenderTests.fs | 4 ++-- .../MessageSystemBaseTests.fs | 4 ++-- Emulsion.Tests/Telegram/LinkGeneratorTests.fs | 2 +- Emulsion.Tests/Web/ContentControllerTests.fs | 4 ++-- Emulsion.Tests/Xmpp/EmulsionXmppTests.fs | 2 +- Emulsion.Tests/Xmpp/XmppClientRoomTests.fs | 2 +- Emulsion.sln | 6 +++++ 22 files changed, 53 insertions(+), 31 deletions(-) create mode 100644 Emulsion.TestFramework/Emulsion.TestFramework.fsproj rename {Emulsion.Tests/TestUtils => Emulsion.TestFramework}/Exceptions.fs (90%) rename {Emulsion.Tests/TestUtils => Emulsion.TestFramework}/LockedBuffer.fs (90%) rename {Emulsion.Tests/TestUtils => Emulsion.TestFramework}/Logging.fs (82%) rename {Emulsion.Tests/TestUtils => Emulsion.TestFramework}/TelegramClientMock.fs (90%) rename {Emulsion.Tests/TestUtils => Emulsion.TestFramework}/TestDataStorage.fs (88%) rename {Emulsion.Tests/TestUtils => Emulsion.TestFramework}/Waiter.fs (91%) rename {Emulsion.Tests/TestUtils => Emulsion.TestFramework}/WebFileStorage.fs (88%) diff --git a/Emulsion.TestFramework/Emulsion.TestFramework.fsproj b/Emulsion.TestFramework/Emulsion.TestFramework.fsproj new file mode 100644 index 00000000..fcfeedab --- /dev/null +++ b/Emulsion.TestFramework/Emulsion.TestFramework.fsproj @@ -0,0 +1,23 @@ + + + + net6.0 + true + + + + + + + + + + + + + + + + + + diff --git a/Emulsion.Tests/TestUtils/Exceptions.fs b/Emulsion.TestFramework/Exceptions.fs similarity index 90% rename from Emulsion.Tests/TestUtils/Exceptions.fs rename to Emulsion.TestFramework/Exceptions.fs index fa5654bd..85c4b55c 100644 --- a/Emulsion.Tests/TestUtils/Exceptions.fs +++ b/Emulsion.TestFramework/Exceptions.fs @@ -1,4 +1,4 @@ -module Emulsion.Tests.TestUtils.Exceptions +module Emulsion.TestFramework.Exceptions open System open Microsoft.EntityFrameworkCore diff --git a/Emulsion.Tests/TestUtils/LockedBuffer.fs b/Emulsion.TestFramework/LockedBuffer.fs similarity index 90% rename from Emulsion.Tests/TestUtils/LockedBuffer.fs rename to Emulsion.TestFramework/LockedBuffer.fs index 951f7165..dfae3891 100644 --- a/Emulsion.Tests/TestUtils/LockedBuffer.fs +++ b/Emulsion.TestFramework/LockedBuffer.fs @@ -1,4 +1,4 @@ -namespace Emulsion.Tests.TestUtils +namespace Emulsion.TestFramework type LockedBuffer<'T>() = let messages = ResizeArray<'T>() diff --git a/Emulsion.Tests/TestUtils/Logging.fs b/Emulsion.TestFramework/Logging.fs similarity index 82% rename from Emulsion.Tests/TestUtils/Logging.fs rename to Emulsion.TestFramework/Logging.fs index 4d73b083..25018f73 100644 --- a/Emulsion.Tests/TestUtils/Logging.fs +++ b/Emulsion.TestFramework/Logging.fs @@ -1,4 +1,4 @@ -module Emulsion.Tests.TestUtils.Logging +module Emulsion.TestFramework.Logging open Serilog open Xunit.Abstractions diff --git a/Emulsion.Tests/TestUtils/TelegramClientMock.fs b/Emulsion.TestFramework/TelegramClientMock.fs similarity index 90% rename from Emulsion.Tests/TestUtils/TelegramClientMock.fs rename to Emulsion.TestFramework/TelegramClientMock.fs index f02c1064..c66c9181 100644 --- a/Emulsion.Tests/TestUtils/TelegramClientMock.fs +++ b/Emulsion.TestFramework/TelegramClientMock.fs @@ -1,4 +1,4 @@ -namespace Emulsion.Tests.TestUtils +namespace Emulsion.TestFramework open System.Collections.Generic diff --git a/Emulsion.Tests/TestUtils/TestDataStorage.fs b/Emulsion.TestFramework/TestDataStorage.fs similarity index 88% rename from Emulsion.Tests/TestUtils/TestDataStorage.fs rename to Emulsion.TestFramework/TestDataStorage.fs index 84b1ea06..0787628f 100644 --- a/Emulsion.Tests/TestUtils/TestDataStorage.fs +++ b/Emulsion.TestFramework/TestDataStorage.fs @@ -1,4 +1,4 @@ -module Emulsion.Tests.TestUtils.TestDataStorage +module Emulsion.TestFramework.TestDataStorage open System.IO diff --git a/Emulsion.Tests/TestUtils/Waiter.fs b/Emulsion.TestFramework/Waiter.fs similarity index 91% rename from Emulsion.Tests/TestUtils/Waiter.fs rename to Emulsion.TestFramework/Waiter.fs index f83e3c93..89fe61f2 100644 --- a/Emulsion.Tests/TestUtils/Waiter.fs +++ b/Emulsion.TestFramework/Waiter.fs @@ -1,4 +1,4 @@ -module Emulsion.Tests.TestUtils.Waiter +module Emulsion.TestFramework.Waiter open System open System.Threading diff --git a/Emulsion.Tests/TestUtils/WebFileStorage.fs b/Emulsion.TestFramework/WebFileStorage.fs similarity index 88% rename from Emulsion.Tests/TestUtils/WebFileStorage.fs rename to Emulsion.TestFramework/WebFileStorage.fs index 5a859cb3..b9ae0a3c 100644 --- a/Emulsion.Tests/TestUtils/WebFileStorage.fs +++ b/Emulsion.TestFramework/WebFileStorage.fs @@ -1,4 +1,4 @@ -namespace Emulsion.Tests.TestUtils +namespace Emulsion.TestFramework open System diff --git a/Emulsion.Tests/Actors/Core.fs b/Emulsion.Tests/Actors/Core.fs index 0ea58530..ced5b542 100644 --- a/Emulsion.Tests/Actors/Core.fs +++ b/Emulsion.Tests/Actors/Core.fs @@ -9,7 +9,7 @@ open Xunit.Abstractions open Emulsion open Emulsion.Actors open Emulsion.Messaging -open Emulsion.Tests.TestUtils +open Emulsion.TestFramework type CoreTests(testOutput: ITestOutputHelper) as this = inherit TestKit() diff --git a/Emulsion.Tests/Actors/Telegram.fs b/Emulsion.Tests/Actors/Telegram.fs index 28b496ad..97285a40 100644 --- a/Emulsion.Tests/Actors/Telegram.fs +++ b/Emulsion.Tests/Actors/Telegram.fs @@ -8,7 +8,7 @@ open Emulsion open Emulsion.Actors open Emulsion.Messaging open Emulsion.Messaging.MessageSystem -open Emulsion.Tests.TestUtils +open Emulsion.TestFramework type TelegramTest(testOutput: ITestOutputHelper) = inherit TestKit() diff --git a/Emulsion.Tests/Actors/Xmpp.fs b/Emulsion.Tests/Actors/Xmpp.fs index 24ac6de8..5e256acb 100644 --- a/Emulsion.Tests/Actors/Xmpp.fs +++ b/Emulsion.Tests/Actors/Xmpp.fs @@ -8,7 +8,7 @@ open Emulsion open Emulsion.Actors open Emulsion.Messaging open Emulsion.Messaging.MessageSystem -open Emulsion.Tests.TestUtils +open Emulsion.TestFramework type XmppTest(testOutput: ITestOutputHelper) = inherit TestKit() diff --git a/Emulsion.Tests/ContentProxy/ContentStorageTests.fs b/Emulsion.Tests/ContentProxy/ContentStorageTests.fs index 81bc0ca2..40044506 100644 --- a/Emulsion.Tests/ContentProxy/ContentStorageTests.fs +++ b/Emulsion.Tests/ContentProxy/ContentStorageTests.fs @@ -4,7 +4,7 @@ open Xunit open Emulsion.ContentProxy.ContentStorage open Emulsion.Database -open Emulsion.Tests.TestUtils +open Emulsion.TestFramework let private testIdentity = { ChatUserName = "test" diff --git a/Emulsion.Tests/ContentProxy/FileCacheTests.fs b/Emulsion.Tests/ContentProxy/FileCacheTests.fs index 9baae38d..f0f22a4f 100644 --- a/Emulsion.Tests/ContentProxy/FileCacheTests.fs +++ b/Emulsion.Tests/ContentProxy/FileCacheTests.fs @@ -11,8 +11,8 @@ open Xunit.Abstractions open Emulsion.ContentProxy open Emulsion.Settings -open Emulsion.Tests.TestUtils -open Emulsion.Tests.TestUtils.Logging +open Emulsion.TestFramework +open Emulsion.TestFramework.Logging type FileCacheTests(outputHelper: ITestOutputHelper) = diff --git a/Emulsion.Tests/Database/DatabaseStructureTests.fs b/Emulsion.Tests/Database/DatabaseStructureTests.fs index e2ca8f79..1bb3f101 100644 --- a/Emulsion.Tests/Database/DatabaseStructureTests.fs +++ b/Emulsion.Tests/Database/DatabaseStructureTests.fs @@ -5,7 +5,7 @@ open Xunit open Emulsion.Database open Emulsion.Database.Entities -open Emulsion.Tests.TestUtils +open Emulsion.TestFramework [] let ``Unique constraint should hold``(): unit = diff --git a/Emulsion.Tests/Emulsion.Tests.fsproj b/Emulsion.Tests/Emulsion.Tests.fsproj index 47821122..44998653 100644 --- a/Emulsion.Tests/Emulsion.Tests.fsproj +++ b/Emulsion.Tests/Emulsion.Tests.fsproj @@ -4,13 +4,6 @@ false - - - - - - - @@ -42,10 +35,10 @@ - + \ No newline at end of file diff --git a/Emulsion.Tests/MessageSenderTests.fs b/Emulsion.Tests/MessageSenderTests.fs index f0030c27..fa353857 100644 --- a/Emulsion.Tests/MessageSenderTests.fs +++ b/Emulsion.Tests/MessageSenderTests.fs @@ -11,8 +11,8 @@ open Xunit.Abstractions open Emulsion.Messaging open Emulsion.Messaging.MessageSender -open Emulsion.Tests.TestUtils -open Emulsion.Tests.TestUtils.Waiter +open Emulsion.TestFramework +open Emulsion.TestFramework.Waiter type MessageSenderTests(testOutput: ITestOutputHelper) = let testContext = { diff --git a/Emulsion.Tests/MessageSystemTests/MessageSystemBaseTests.fs b/Emulsion.Tests/MessageSystemTests/MessageSystemBaseTests.fs index 6fb5b561..f34747f0 100644 --- a/Emulsion.Tests/MessageSystemTests/MessageSystemBaseTests.fs +++ b/Emulsion.Tests/MessageSystemTests/MessageSystemBaseTests.fs @@ -10,8 +10,8 @@ open Xunit.Abstractions open Emulsion open Emulsion.Messaging open Emulsion.Messaging.MessageSystem -open Emulsion.Tests.TestUtils -open Emulsion.Tests.TestUtils.Waiter +open Emulsion.TestFramework +open Emulsion.TestFramework.Waiter type MessageSystemBaseTests(testLogger: ITestOutputHelper) = let logger = Logging.xunitLogger testLogger diff --git a/Emulsion.Tests/Telegram/LinkGeneratorTests.fs b/Emulsion.Tests/Telegram/LinkGeneratorTests.fs index ea579b82..e4960554 100644 --- a/Emulsion.Tests/Telegram/LinkGeneratorTests.fs +++ b/Emulsion.Tests/Telegram/LinkGeneratorTests.fs @@ -10,7 +10,7 @@ open Xunit open Emulsion.Database open Emulsion.Settings open Emulsion.Telegram -open Emulsion.Tests.TestUtils +open Emulsion.TestFramework let private hostingSettings = { ExternalUriBase = Uri "https://example.com" diff --git a/Emulsion.Tests/Web/ContentControllerTests.fs b/Emulsion.Tests/Web/ContentControllerTests.fs index da119697..1aa4fbaa 100644 --- a/Emulsion.Tests/Web/ContentControllerTests.fs +++ b/Emulsion.Tests/Web/ContentControllerTests.fs @@ -14,8 +14,8 @@ open Emulsion.Database open Emulsion.Database.Entities open Emulsion.Settings open Emulsion.Telegram -open Emulsion.Tests.TestUtils -open Emulsion.Tests.TestUtils.Logging +open Emulsion.TestFramework +open Emulsion.TestFramework.Logging open Emulsion.Web type ContentControllerTests(output: ITestOutputHelper) = diff --git a/Emulsion.Tests/Xmpp/EmulsionXmppTests.fs b/Emulsion.Tests/Xmpp/EmulsionXmppTests.fs index 1e7d894b..5a2bbb80 100644 --- a/Emulsion.Tests/Xmpp/EmulsionXmppTests.fs +++ b/Emulsion.Tests/Xmpp/EmulsionXmppTests.fs @@ -14,7 +14,7 @@ open Xunit.Abstractions open Emulsion open Emulsion.Messaging open Emulsion.Settings -open Emulsion.Tests.TestUtils +open Emulsion.TestFramework open Emulsion.Tests.Xmpp open Emulsion.Xmpp open Emulsion.Xmpp.SharpXmppHelper.Elements diff --git a/Emulsion.Tests/Xmpp/XmppClientRoomTests.fs b/Emulsion.Tests/Xmpp/XmppClientRoomTests.fs index abe1dc97..5d0a678c 100644 --- a/Emulsion.Tests/Xmpp/XmppClientRoomTests.fs +++ b/Emulsion.Tests/Xmpp/XmppClientRoomTests.fs @@ -14,7 +14,7 @@ open Emulsion open Emulsion.Xmpp open Emulsion.Xmpp.SharpXmppHelper.Attributes open Emulsion.Xmpp.SharpXmppHelper.Elements -open Emulsion.Tests.TestUtils.Logging +open Emulsion.TestFramework.Logging type XmppClientRoomTests(output: ITestOutputHelper) = let logger = xunitLogger output diff --git a/Emulsion.sln b/Emulsion.sln index ab2ffc42..0f56025d 100644 --- a/Emulsion.sln +++ b/Emulsion.sln @@ -48,6 +48,8 @@ Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Emulsion.Telegram", "Emulsi EndProject Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Emulsion.Messaging", "Emulsion.Messaging\Emulsion.Messaging.fsproj", "{C8DC4049-250B-4E84-BC98-CFC0AF1632AF}" EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Emulsion.TestFramework", "Emulsion.TestFramework\Emulsion.TestFramework.fsproj", "{381D687B-6520-48F1-8AA0-3EDB45654AAC}" +EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|Any CPU = Debug|Any CPU @@ -89,6 +91,10 @@ Global {C8DC4049-250B-4E84-BC98-CFC0AF1632AF}.Debug|Any CPU.Build.0 = Debug|Any CPU {C8DC4049-250B-4E84-BC98-CFC0AF1632AF}.Release|Any CPU.ActiveCfg = Release|Any CPU {C8DC4049-250B-4E84-BC98-CFC0AF1632AF}.Release|Any CPU.Build.0 = Release|Any CPU + {381D687B-6520-48F1-8AA0-3EDB45654AAC}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {381D687B-6520-48F1-8AA0-3EDB45654AAC}.Debug|Any CPU.Build.0 = Debug|Any CPU + {381D687B-6520-48F1-8AA0-3EDB45654AAC}.Release|Any CPU.ActiveCfg = Release|Any CPU + {381D687B-6520-48F1-8AA0-3EDB45654AAC}.Release|Any CPU.Build.0 = Release|Any CPU EndGlobalSection GlobalSection(NestedProjects) = preSolution {7D1ADF47-BF1C-4007-BB9B-08C283044467} = {973131E1-E645-4A50-A0D2-1886A1A8F0C6} From 4d6bfc5e0164d10433f4ec3eb0cbb6a7554106d4 Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sun, 21 Aug 2022 21:43:47 +0200 Subject: [PATCH 06/23] (#102) ContentProxy: finish working FileCache --- .../Emulsion.ContentProxy.fsproj | 2 + Emulsion.ContentProxy/FileCache.fs | 92 +++++++++++++++---- .../Emulsion.TestFramework.fsproj | 4 +- .../SimpleHttpClientFactory.fs | 7 ++ Emulsion.TestFramework/WebFileStorage.fs | 32 ++++++- Emulsion.Tests/ContentProxy/FileCacheTests.fs | 20 +++- Emulsion.sln.DotSettings | 1 + 7 files changed, 130 insertions(+), 28 deletions(-) create mode 100644 Emulsion.TestFramework/SimpleHttpClientFactory.fs diff --git a/Emulsion.ContentProxy/Emulsion.ContentProxy.fsproj b/Emulsion.ContentProxy/Emulsion.ContentProxy.fsproj index 8a528a74..f086ead5 100644 --- a/Emulsion.ContentProxy/Emulsion.ContentProxy.fsproj +++ b/Emulsion.ContentProxy/Emulsion.ContentProxy.fsproj @@ -17,7 +17,9 @@ + + diff --git a/Emulsion.ContentProxy/FileCache.fs b/Emulsion.ContentProxy/FileCache.fs index 6159dd8e..e74606b8 100644 --- a/Emulsion.ContentProxy/FileCache.fs +++ b/Emulsion.ContentProxy/FileCache.fs @@ -2,12 +2,15 @@ open System open System.IO +open System.Net.Http open System.Security.Cryptography open System.Text - open System.Threading -open Emulsion.Settings + open Serilog +open SimpleBase + +open Emulsion.Settings type DownloadRequest = { Uri: Uri @@ -15,40 +18,87 @@ type DownloadRequest = { Size: uint64 } +module Base58 = + /// Suggested by @ttldtor. + let M4N71KR = Base58(Base58Alphabet "123456789qwertyuiopasdfghjkzxcvbnmQWERTYUPASDFGHJKLZXCVBNM") + module FileCache = - let FileName(sha256: SHA256, cacheKey: string): string = + let EncodeFileName(sha256: SHA256, cacheKey: string): string = cacheKey |> Encoding.UTF8.GetBytes |> sha256.ComputeHash - |> Convert.ToBase64String + |> Base58.M4N71KR.Encode + + let DecodeFileNameToSha256Hash(fileName: string): byte[] = + (Base58.M4N71KR.Decode fileName).ToArray() -// TODO: Total cache limit type FileCache(logger: ILogger, settings: FileCacheSettings, + httpClientFactory: IHttpClientFactory, sha256: SHA256) = let getFilePath(cacheKey: string) = - Path.Combine(settings.Directory, FileCache.FileName(sha256, cacheKey)) + Path.Combine(settings.Directory, FileCache.EncodeFileName(sha256, cacheKey)) let getFromCache(cacheKey: string) = async { let path = getFilePath cacheKey return if File.Exists path then - Some(new FileStream(path, FileMode.Open, FileAccess.Read, FileShare.Delete)) + Some(new FileStream(path, FileMode.Open, FileAccess.Read, FileShare.Read|||FileShare.Delete)) else None } - // TODO: Check total item size, too + let assertCacheValid() = async { + Directory.EnumerateFileSystemEntries settings.Directory + |> Seq.iter(fun entry -> + let entryName = Path.GetFileName entry + + if not <| File.Exists entry + then failwith $"Cache directory invalid: contains a subdirectory: \"{entryName}\"." + + let hash = FileCache.DecodeFileNameToSha256Hash entryName + if hash.Length <> sha256.HashSize / 8 + then failwith ( + $"Cache directory invalid: contains entry \"{entryName}\" which doesn't correspond to a " + + "base58-encoded SHA-256 hash." + ) + ) + } + let ensureFreeCache size = async { - if size > settings.FileSizeLimitBytes then + if size > settings.FileSizeLimitBytes || size > settings.TotalCacheSizeLimitBytes then return false else - return failwith "TODO: Sanity check that cache only has files" + do! assertCacheValid() + + let allEntries = + Directory.EnumerateFileSystemEntries settings.Directory + |> Seq.map FileInfo + + // Now, sort the entries from newest to oldest, and start deleting if required at a point when we understand + // that there are too much files: + let entriesByPriority = + allEntries + |> Seq.sortByDescending(fun info -> info.LastWriteTimeUtc) + |> Seq.toArray + + let mutable currentSize = 0UL + for info in entriesByPriority do + currentSize <- currentSize + Checked.uint64 info.Length + if currentSize + size > settings.TotalCacheSizeLimitBytes then + logger.Information("Deleting a cache item \"{FileName}\" ({Size} bytes)", info.Name, info.Length) + info.Delete() + + return true } - let download uri: Async = async { - return failwithf "TODO: Download the URI and return a stream" + let download(uri: Uri): Async = async { + let! ct = Async.CancellationToken + + use client = httpClientFactory.CreateClient() + let! response = Async.AwaitTask <| client.GetAsync(uri, ct) + return! Async.AwaitTask <| response.EnsureSuccessStatusCode().Content.ReadAsStreamAsync() } let downloadIntoCacheAndGet uri cacheKey: Async = async { @@ -57,21 +107,23 @@ type FileCache(logger: ILogger, let path = getFilePath cacheKey logger.Information("Saving {Uri} to path {Path}…", uri, path) - use cachedFile = new FileStream(path, FileMode.Open, FileAccess.Write, FileShare.None) - do! Async.AwaitTask(stream.CopyToAsync(cachedFile, ct)) - logger.Information("Download successful: \"{Uri}\" to \"{Path}\".") + do! async { // to limit the cachedFile scope + use cachedFile = new FileStream(path, FileMode.CreateNew, FileAccess.Write, FileShare.None) + do! Async.AwaitTask(stream.CopyToAsync(cachedFile, ct)) + logger.Information("Download successful: \"{Uri}\" to \"{Path}\".") + } let! file = getFromCache cacheKey return upcast Option.get file } let cancellation = new CancellationTokenSource() - let processRequest request: Async = async { + let processRequest request: Async = async { logger.Information("Cache lookup for content {Uri} (cache key {CacheKey})", request.Uri, request.CacheKey) match! getFromCache request.CacheKey with | Some content -> logger.Information("Cache hit for content {Uri} (cache key {CacheKey})", request.Uri, request.CacheKey) - return Some content + return content | None -> logger.Information("No cache hit for content {Uri} (cache key {CacheKey}), will download", request.Uri, request.CacheKey) let! shouldCache = ensureFreeCache request.Size @@ -79,11 +131,11 @@ type FileCache(logger: ILogger, logger.Information("Resource {Uri} (cache key {CacheKey}, {Size} bytes) will fit into cache, caching", request.Uri, request.CacheKey, request.Size) let! result = downloadIntoCacheAndGet request.Uri request.CacheKey logger.Information("Resource {Uri} (cache key {CacheKey}, {Size} bytes) downloaded", request.Uri, request.CacheKey, request.Size) - return Some result + return result else logger.Information("Resource {Uri} (cache key {CacheKey}) won't fit into cache, directly downloading", request.Uri, request.CacheKey) let! result = download request.Uri - return Some result + return result } let rec processLoop(processor: MailboxProcessor<_ * AsyncReplyChannel<_>>) = async { @@ -91,7 +143,7 @@ type FileCache(logger: ILogger, let! request, replyChannel = processor.Receive() try let! result = processRequest request - replyChannel.Reply result + replyChannel.Reply(Some result) with | ex -> logger.Error(ex, "Exception while processing the file download queue") diff --git a/Emulsion.TestFramework/Emulsion.TestFramework.fsproj b/Emulsion.TestFramework/Emulsion.TestFramework.fsproj index fcfeedab..8d086454 100644 --- a/Emulsion.TestFramework/Emulsion.TestFramework.fsproj +++ b/Emulsion.TestFramework/Emulsion.TestFramework.fsproj @@ -1,8 +1,9 @@ - + net6.0 true + Library @@ -13,6 +14,7 @@ + diff --git a/Emulsion.TestFramework/SimpleHttpClientFactory.fs b/Emulsion.TestFramework/SimpleHttpClientFactory.fs new file mode 100644 index 00000000..e024a00b --- /dev/null +++ b/Emulsion.TestFramework/SimpleHttpClientFactory.fs @@ -0,0 +1,7 @@ +namespace Emulsion.TestFramework + +open System.Net.Http + +type SimpleHttpClientFactory() = + interface IHttpClientFactory with + member this.CreateClient _ = new HttpClient() diff --git a/Emulsion.TestFramework/WebFileStorage.fs b/Emulsion.TestFramework/WebFileStorage.fs index b9ae0a3c..28e3e66a 100644 --- a/Emulsion.TestFramework/WebFileStorage.fs +++ b/Emulsion.TestFramework/WebFileStorage.fs @@ -1,14 +1,38 @@ namespace Emulsion.TestFramework open System +open System.Net +open System.Net.Sockets + +open Microsoft.AspNetCore.Builder +open Microsoft.AspNetCore.Http + +module private NetUtil = + let findFreePort() = + use socket = new Socket(SocketType.Stream, ProtocolType.Tcp) + socket.Bind(IPEndPoint(IPAddress.Loopback, 0)) + (socket.LocalEndPoint :?> IPEndPoint).Port type WebFileStorage(data: Map) = + let url = $"http://localhost:{NetUtil.findFreePort()}" + + let startWebApplication() = + let builder = WebApplication.CreateBuilder() + let app = builder.Build() + app.MapGet("/{entry}", Func<_, _>(fun (entry: string) -> task { + return Results.Bytes(data[entry]) + })) |> ignore + app, app.RunAsync url + + let app, task = startWebApplication() + member _.Link(entry: string): Uri = - failwith "todo" + Uri $"{url}/{entry}" member _.Content(entry: string): byte[] = - failwith "todo" + data[entry] interface IDisposable with - member this.Dispose(): unit = failwith "todo" - + member this.Dispose(): unit = + app.StopAsync().Wait() + task.Wait() diff --git a/Emulsion.Tests/ContentProxy/FileCacheTests.fs b/Emulsion.Tests/ContentProxy/FileCacheTests.fs index f0f22a4f..4ad4903e 100644 --- a/Emulsion.Tests/ContentProxy/FileCacheTests.fs +++ b/Emulsion.Tests/ContentProxy/FileCacheTests.fs @@ -32,7 +32,7 @@ type FileCacheTests(outputHelper: ITestOutputHelper) = TotalCacheSizeLimitBytes = totalLimitBytes } - new FileCache(xunitLogger outputHelper, settings, sha256) + new FileCache(xunitLogger outputHelper, settings, SimpleHttpClientFactory(), sha256) let assertCacheState(entries: (string * byte[]) seq) = let files = @@ -46,10 +46,20 @@ type FileCacheTests(outputHelper: ITestOutputHelper) = let entries = entries - |> Seq.map(fun (k, v) -> FileCache.FileName(sha256, k), v) + |> Seq.map(fun (k, v) -> FileCache.EncodeFileName(sha256, k), v) |> Map.ofSeq - Assert.Equal>(entries, files) + Assert.Equal>(entries.Keys, files.Keys) + for key in entries.Keys do + Assert.Equal>(entries[key], files[key]) + + [] + member _.``File cache should throw a validation exception if the cache directory contains directories``(): unit = + Assert.False true + + [] + member _.``File cache should throw a validation exception if the cache directory contains non-conventionally-named files``(): unit = + Assert.False true [] member _.``File should be cached``(): unit = @@ -84,6 +94,10 @@ type FileCacheTests(outputHelper: ITestOutputHelper) = |] } + [] + member _.``File cache cleanup works in order by file modification dates``(): unit = + Assert.False true + [] member _.``File should be read even after cleanup``(): unit = Assert.False true diff --git a/Emulsion.sln.DotSettings b/Emulsion.sln.DotSettings index a93531a6..b2e4be22 100644 --- a/Emulsion.sln.DotSettings +++ b/Emulsion.sln.DotSettings @@ -3,5 +3,6 @@ True True True + True True True \ No newline at end of file From a5e26a106ec256a06510d3b3e9f022951d6766ef Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Thu, 25 Aug 2022 22:27:58 +0200 Subject: [PATCH 07/23] (#102) FileCacheTests: implement an ordering test --- Emulsion.Tests/ContentProxy/FileCacheTests.fs | 33 ++++++++++++++----- 1 file changed, 25 insertions(+), 8 deletions(-) diff --git a/Emulsion.Tests/ContentProxy/FileCacheTests.fs b/Emulsion.Tests/ContentProxy/FileCacheTests.fs index 4ad4903e..da23f9c5 100644 --- a/Emulsion.Tests/ContentProxy/FileCacheTests.fs +++ b/Emulsion.Tests/ContentProxy/FileCacheTests.fs @@ -53,6 +53,11 @@ type FileCacheTests(outputHelper: ITestOutputHelper) = for key in entries.Keys do Assert.Equal>(entries[key], files[key]) + let assertFileDownloaded (fileCache: FileCache) (fileStorage: WebFileStorage) entry size = async { + let! file = fileCache.Download(fileStorage.Link entry, entry, size) + Assert.True file.IsSome + } + [] member _.``File cache should throw a validation exception if the cache directory contains directories``(): unit = Assert.False true @@ -78,16 +83,13 @@ type FileCacheTests(outputHelper: ITestOutputHelper) = "c", [| 3uy |] |]) - let! file = fileCache.Download(fileStorage.Link("a"), "a", 128UL) - Assert.True file.IsSome + do! assertFileDownloaded fileCache fileStorage "a" 128UL assertCacheState [| "a", fileStorage.Content("a") |] - let! file = fileCache.Download(fileStorage.Link("b"), "b", 128UL) - Assert.True file.IsSome + do! assertFileDownloaded fileCache fileStorage "b" 128UL assertCacheState [| "b", fileStorage.Content("b") |] - let! file = fileCache.Download(fileStorage.Link("c"), "c", 1UL) - Assert.True file.IsSome + do! assertFileDownloaded fileCache fileStorage "c" 1UL assertCacheState [| "b", fileStorage.Content("b") "c", fileStorage.Content("c") @@ -95,8 +97,23 @@ type FileCacheTests(outputHelper: ITestOutputHelper) = } [] - member _.``File cache cleanup works in order by file modification dates``(): unit = - Assert.False true + member _.``File cache cleanup works in order by file modification dates``(): Task = task { + use fileCache = setUpFileCache 2UL + use fileStorage = new WebFileStorage(Map.ofArray [| + "a", [| 1uy |] + "b", [| 2uy |] + "c", [| 3uy |] + |]) + + do! assertFileDownloaded fileCache fileStorage "a" 1UL + do! assertFileDownloaded fileCache fileStorage "c" 1UL + do! assertFileDownloaded fileCache fileStorage "b" 1UL // "a" should be deleted + assertCacheState [| "b", [| 2uy |] + "c", [| 3uy |] |] + do! assertFileDownloaded fileCache fileStorage "a" 1UL // "c" should be deleted + assertCacheState [| "a", [| 1uy |] + "b", [| 2uy |] |] + } [] member _.``File should be read even after cleanup``(): unit = From 6ea489202b325bd95df20c5a6e6efcb44819c01c Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Thu, 25 Aug 2022 22:55:11 +0200 Subject: [PATCH 08/23] (#102) FileCache: cache directory validation tests --- .../Emulsion.ContentProxy.fsproj | 1 + Emulsion.ContentProxy/FileCache.fs | 30 ++++++++++++------- Emulsion.Tests/ContentProxy/FileCacheTests.fs | 27 +++++++++++++++-- 3 files changed, 46 insertions(+), 12 deletions(-) diff --git a/Emulsion.ContentProxy/Emulsion.ContentProxy.fsproj b/Emulsion.ContentProxy/Emulsion.ContentProxy.fsproj index f086ead5..1f34e60c 100644 --- a/Emulsion.ContentProxy/Emulsion.ContentProxy.fsproj +++ b/Emulsion.ContentProxy/Emulsion.ContentProxy.fsproj @@ -17,6 +17,7 @@ + diff --git a/Emulsion.ContentProxy/FileCache.fs b/Emulsion.ContentProxy/FileCache.fs index e74606b8..8336f4dd 100644 --- a/Emulsion.ContentProxy/FileCache.fs +++ b/Emulsion.ContentProxy/FileCache.fs @@ -7,6 +7,7 @@ open System.Security.Cryptography open System.Text open System.Threading +open JetBrains.Collections.Viewable open Serilog open SimpleBase @@ -29,14 +30,19 @@ module FileCache = |> sha256.ComputeHash |> Base58.M4N71KR.Encode - let DecodeFileNameToSha256Hash(fileName: string): byte[] = - (Base58.M4N71KR.Decode fileName).ToArray() + let TryDecodeFileNameToSha256Hash(fileName: string): byte[] option = + try + Some <| (Base58.M4N71KR.Decode fileName).ToArray() + with + | :? ArgumentException -> None type FileCache(logger: ILogger, settings: FileCacheSettings, httpClientFactory: IHttpClientFactory, sha256: SHA256) = + let error = Signal() + let getFilePath(cacheKey: string) = Path.Combine(settings.Directory, FileCache.EncodeFileName(sha256, cacheKey)) @@ -55,14 +61,15 @@ type FileCache(logger: ILogger, let entryName = Path.GetFileName entry if not <| File.Exists entry - then failwith $"Cache directory invalid: contains a subdirectory: \"{entryName}\"." - - let hash = FileCache.DecodeFileNameToSha256Hash entryName - if hash.Length <> sha256.HashSize / 8 - then failwith ( - $"Cache directory invalid: contains entry \"{entryName}\" which doesn't correspond to a " + - "base58-encoded SHA-256 hash." - ) + then failwith $"Cache directory invalid: contains a subdirectory \"{entryName}\"." + + match FileCache.TryDecodeFileNameToSha256Hash entryName with + | Some hash when hash.Length = sha256.HashSize / 8 -> () + | _ -> + failwith ( + $"Cache directory invalid: contains an entry \"{entryName}\" which doesn't correspond to a " + + "base58-encoded SHA-256 hash." + ) ) } @@ -147,6 +154,7 @@ type FileCache(logger: ILogger, with | ex -> logger.Error(ex, "Exception while processing the file download queue") + error.Fire ex replyChannel.Reply None } let processor = MailboxProcessor.Start(processLoop, cancellation.Token) @@ -162,3 +170,5 @@ type FileCache(logger: ILogger, CacheKey = cacheKey Size = size }, chan)) + + member _.Error: ISource = error diff --git a/Emulsion.Tests/ContentProxy/FileCacheTests.fs b/Emulsion.Tests/ContentProxy/FileCacheTests.fs index da23f9c5..a4c28e1e 100644 --- a/Emulsion.Tests/ContentProxy/FileCacheTests.fs +++ b/Emulsion.Tests/ContentProxy/FileCacheTests.fs @@ -6,6 +6,7 @@ open System.IO open System.Security.Cryptography open System.Threading.Tasks +open JetBrains.Lifetimes open Xunit open Xunit.Abstractions @@ -58,13 +59,35 @@ type FileCacheTests(outputHelper: ITestOutputHelper) = Assert.True file.IsSome } + let assertCacheValidationError setUpAction expectedMessage = + use fileCache = setUpFileCache 1UL + use fileStorage = new WebFileStorage(Map.empty) + + setUpAction() + + Lifetime.Using(fun lt -> + let mutable error: Exception option = None + fileCache.Error.Advise(lt, fun e -> error <- Some e) + + let file = Async.RunSynchronously <| fileCache.Download(fileStorage.Link "nonexistent", "nonexistent", 1UL) + Assert.True file.IsNone + + Assert.True error.IsSome + Assert.Equal(expectedMessage, error.Value.Message) + ) + [] member _.``File cache should throw a validation exception if the cache directory contains directories``(): unit = - Assert.False true + assertCacheValidationError + (fun() -> Directory.CreateDirectory(Path.Combine(cacheDirectory.Value, "aaa")) |> ignore) + "Cache directory invalid: contains a subdirectory \"aaa\"." [] member _.``File cache should throw a validation exception if the cache directory contains non-conventionally-named files``(): unit = - Assert.False true + assertCacheValidationError + (fun() -> File.Create(Path.Combine(cacheDirectory.Value, "aaa.txt")).Dispose()) + ("Cache directory invalid: contains an entry \"aaa.txt\" which doesn't correspond to a base58-encoded " + + "SHA-256 hash.") [] member _.``File should be cached``(): unit = From cb218b65d90b49a12803030d73715fcc74713818 Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sat, 27 Aug 2022 22:10:50 +0200 Subject: [PATCH 09/23] (#102) FileCache: additional tests --- Emulsion.Tests/ContentProxy/FileCacheTests.fs | 37 +++++++++++++++++-- 1 file changed, 33 insertions(+), 4 deletions(-) diff --git a/Emulsion.Tests/ContentProxy/FileCacheTests.fs b/Emulsion.Tests/ContentProxy/FileCacheTests.fs index a4c28e1e..281089f8 100644 --- a/Emulsion.Tests/ContentProxy/FileCacheTests.fs +++ b/Emulsion.Tests/ContentProxy/FileCacheTests.fs @@ -76,6 +76,12 @@ type FileCacheTests(outputHelper: ITestOutputHelper) = Assert.Equal(expectedMessage, error.Value.Message) ) + let readAllBytes (stream: Stream) = task { + use buffer = new MemoryStream() + do! stream.CopyToAsync buffer + return buffer.ToArray() + } + [] member _.``File cache should throw a validation exception if the cache directory contains directories``(): unit = assertCacheValidationError @@ -90,8 +96,15 @@ type FileCacheTests(outputHelper: ITestOutputHelper) = "SHA-256 hash.") [] - member _.``File should be cached``(): unit = - Assert.False true + member _.``File should be cached``(): Task = task { + use fileCache = setUpFileCache 1024UL + use fileStorage = new WebFileStorage(Map.ofArray [| + "a", [| for _ in 1 .. 5 do yield 1uy |] + |]) + + do! assertFileDownloaded fileCache fileStorage "a" 5UL + assertCacheState [| "a", fileStorage.Content("a") |] + } [] member _.``Too big file should be proxied``(): unit = @@ -143,8 +156,24 @@ type FileCacheTests(outputHelper: ITestOutputHelper) = Assert.False true [] - member _.``File should be re-downloaded after cleanup even if there's a outdated read session in progress``(): unit = - Assert.False true + member _.``File should be re-downloaded after cleanup even if there's a outdated read session in progress``(): Task = task { + use fileCache = setUpFileCache (1024UL * 1024UL) + use fileStorage = new WebFileStorage(Map.ofArray [| + "a", [| for _ in 1 .. 1024 * 1024 do 1uy |] + "b", [| for _ in 1 .. 1024 * 1024 do 2uy |] + |]) + + // Start downloading the "a" item: + let! stream = fileCache.Download(fileStorage.Link "a", "a", 1024UL * 1024UL) + let stream = Option.get stream + // Just keep the stream open for now and trigger the cleanup: + do! assertFileDownloaded fileCache fileStorage "b" (1024UL * 1024UL) + // Now there's only "b" item in the cache: + assertCacheState [| "b", fileStorage.Content "b" |] + // We should still be able to read "a" fully: + let! content = readAllBytes stream + Assert.Equal(fileStorage.Content "a", content) + } interface IDisposable with member _.Dispose() = sha256.Dispose() From b50d6154015f08f9d132dd89fbb5b9a525f343c7 Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sat, 27 Aug 2022 22:26:17 +0200 Subject: [PATCH 10/23] (#102) FileCache: finish the last tests --- Emulsion.Tests/ContentProxy/FileCacheTests.fs | 45 +++++++++++++++---- 1 file changed, 37 insertions(+), 8 deletions(-) diff --git a/Emulsion.Tests/ContentProxy/FileCacheTests.fs b/Emulsion.Tests/ContentProxy/FileCacheTests.fs index 281089f8..8d50e7d5 100644 --- a/Emulsion.Tests/ContentProxy/FileCacheTests.fs +++ b/Emulsion.Tests/ContentProxy/FileCacheTests.fs @@ -29,7 +29,7 @@ type FileCacheTests(outputHelper: ITestOutputHelper) = let setUpFileCache(totalLimitBytes: uint64) = let settings = { Directory = cacheDirectory.Value - FileSizeLimitBytes = 1048576UL + FileSizeLimitBytes = 10UL * 1024UL * 1024UL TotalCacheSizeLimitBytes = totalLimitBytes } @@ -107,8 +107,15 @@ type FileCacheTests(outputHelper: ITestOutputHelper) = } [] - member _.``Too big file should be proxied``(): unit = - Assert.False true + member _.``Too big file should be proxied``(): Task = task { + use fileCache = setUpFileCache 1UL + use fileStorage = new WebFileStorage(Map.ofArray [| + "a", [| for _ in 1 .. 2 do yield 1uy |] + |]) + + do! assertFileDownloaded fileCache fileStorage "a" 2UL + assertCacheState Array.empty + } [] member _.``Cleanup should be triggered``(): Task = task { @@ -152,11 +159,7 @@ type FileCacheTests(outputHelper: ITestOutputHelper) = } [] - member _.``File should be read even after cleanup``(): unit = - Assert.False true - - [] - member _.``File should be re-downloaded after cleanup even if there's a outdated read session in progress``(): Task = task { + member _.``File should be downloaded even if it was cleaned up during download``(): Task = task { use fileCache = setUpFileCache (1024UL * 1024UL) use fileStorage = new WebFileStorage(Map.ofArray [| "a", [| for _ in 1 .. 1024 * 1024 do 1uy |] @@ -175,5 +178,31 @@ type FileCacheTests(outputHelper: ITestOutputHelper) = Assert.Equal(fileStorage.Content "a", content) } + [] + member _.``File should be re-downloaded after cleanup even if there's a outdated read session in progress``(): Task = task { + let size = 2UL * 1024UL * 1024UL + use fileCache = setUpFileCache size + use fileStorage = new WebFileStorage(Map.ofArray [| + "a", [| for _ in 1UL .. size do 1uy |] + "b", [| for _ in 1UL .. size do 2uy |] + |]) + + // Start downloading the "a" item: + let! stream = fileCache.Download(fileStorage.Link "a", "a", size) + let stream = Option.get stream + // Just keep the stream open for now and trigger the cleanup: + do! assertFileDownloaded fileCache fileStorage "b" size + // Now there's only "b" item in the cache: + assertCacheState [| "b", fileStorage.Content "b" |] + // And now, while still having "a" not downloaded, let's fill the cache with it again (could be broken on + // Windows due to peculiarity of file deletion when opened, see + // https://boostgsoc13.github.io/boost.afio/doc/html/afio/FAQ/deleting_open_files.html): + do! assertFileDownloaded fileCache fileStorage "a" size + assertCacheState [| "a", fileStorage.Content "a" |] + // We should still be able to read "a" fully: + let! content = readAllBytes stream + Assert.Equal(fileStorage.Content "a", content) + } + interface IDisposable with member _.Dispose() = sha256.Dispose() From 91004714e3c3ebd381f745271e8f1393f6cf6eee Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sat, 27 Aug 2022 22:35:52 +0200 Subject: [PATCH 11/23] (#102) ContentController: test redirect mode --- Emulsion.Tests/Web/ContentControllerTests.fs | 43 +++++++++++++++----- 1 file changed, 32 insertions(+), 11 deletions(-) diff --git a/Emulsion.Tests/Web/ContentControllerTests.fs b/Emulsion.Tests/Web/ContentControllerTests.fs index 1aa4fbaa..8a41ada8 100644 --- a/Emulsion.Tests/Web/ContentControllerTests.fs +++ b/Emulsion.Tests/Web/ContentControllerTests.fs @@ -42,6 +42,11 @@ type ContentControllerTests(output: ITestOutputHelper) = }) let performTest = performTestWithPreparation(fun _ -> async.Return()) + let performTestWithContent content = performTestWithPreparation (fun databaseOptions -> async { + use context = new EmulsionDbContext(databaseOptions.ContextOptions) + do! DataStorage.addAsync context.TelegramContents content + return! Async.Ignore <| Async.AwaitTask(context.SaveChangesAsync()) + }) [] member _.``ContentController returns BadRequest on hashId deserialization error``(): Task = @@ -59,12 +64,38 @@ type ContentControllerTests(output: ITestOutputHelper) = Assert.IsType result |> ignore }) + [] + member _.``ContentController returns a normal redirect if there's no file cache``(): Task = + let contentId = 343L + let chatUserName = "MySuperExampleChat" + let messageId = 777L + let content = { + Id = contentId + ChatUserName = chatUserName + MessageId = messageId + FileId = "foobar" + } + + performTestWithContent content (fun controller -> async { + let hashId = Proxy.encodeHashId hostingSettings.HashIdSalt contentId + let! result = Async.AwaitTask <| controller.Get hashId + let redirect = Assert.IsType result + Assert.Equal(Uri $"https://t.me/{chatUserName}/{string messageId}", Uri redirect.Url) + }) + + [] member _.``ContentController returns a correct result``(): Task = let contentId = 343L let chatUserName = "MySuperExampleChat" let messageId = 777L let fileId = "foobar" + let content = { + Id = contentId + ChatUserName = chatUserName + MessageId = messageId + FileId = fileId + } let testLink = Uri "https://example.com/myFile" let testFileInfo = { @@ -73,17 +104,7 @@ type ContentControllerTests(output: ITestOutputHelper) = } telegramClient.SetResponse(fileId, Some testFileInfo) - performTestWithPreparation (fun databaseOptions -> async { - use context = new EmulsionDbContext(databaseOptions.ContextOptions) - let content = { - Id = contentId - ChatUserName = chatUserName - MessageId = messageId - FileId = "foobar" - } - do! DataStorage.addAsync context.TelegramContents content - return! Async.Ignore <| Async.AwaitTask(context.SaveChangesAsync()) - }) (fun controller -> async { + performTestWithContent content (fun controller -> async { let hashId = Proxy.encodeHashId hostingSettings.HashIdSalt contentId let! result = Async.AwaitTask <| controller.Get hashId let redirect = Assert.IsType result From 107c4be84a4ff2a540cdd91228ae360a07fada2b Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sat, 27 Aug 2022 23:04:04 +0200 Subject: [PATCH 12/23] (#102) ContentController: last test groundwork --- .../Emulsion.TestFramework.fsproj | 1 + Emulsion.TestFramework/TestFileCache.fs | 22 ++++++++ Emulsion.Tests/ContentProxy/FileCacheTests.fs | 23 ++------ Emulsion.Tests/Web/ContentControllerTests.fs | 56 ++++++++++++++++--- 4 files changed, 76 insertions(+), 26 deletions(-) create mode 100644 Emulsion.TestFramework/TestFileCache.fs diff --git a/Emulsion.TestFramework/Emulsion.TestFramework.fsproj b/Emulsion.TestFramework/Emulsion.TestFramework.fsproj index 8d086454..887232e1 100644 --- a/Emulsion.TestFramework/Emulsion.TestFramework.fsproj +++ b/Emulsion.TestFramework/Emulsion.TestFramework.fsproj @@ -15,6 +15,7 @@ + diff --git a/Emulsion.TestFramework/TestFileCache.fs b/Emulsion.TestFramework/TestFileCache.fs new file mode 100644 index 00000000..b83eedc6 --- /dev/null +++ b/Emulsion.TestFramework/TestFileCache.fs @@ -0,0 +1,22 @@ +module Emulsion.TestFramework.TestFileCache + +open System.IO + +open Emulsion.ContentProxy +open Emulsion.Settings +open Emulsion.TestFramework.Logging + +let newCacheDirectory() = + let path = Path.GetTempFileName() + File.Delete path + Directory.CreateDirectory path |> ignore + path + +let setUpFileCache outputHelper sha256 cacheDirectory (totalLimitBytes: uint64) = + let settings = { + Directory = cacheDirectory + FileSizeLimitBytes = 10UL * 1024UL * 1024UL + TotalCacheSizeLimitBytes = totalLimitBytes + } + + new FileCache(xunitLogger outputHelper, settings, SimpleHttpClientFactory(), sha256) diff --git a/Emulsion.Tests/ContentProxy/FileCacheTests.fs b/Emulsion.Tests/ContentProxy/FileCacheTests.fs index 8d50e7d5..724886de 100644 --- a/Emulsion.Tests/ContentProxy/FileCacheTests.fs +++ b/Emulsion.Tests/ContentProxy/FileCacheTests.fs @@ -11,29 +11,16 @@ open Xunit open Xunit.Abstractions open Emulsion.ContentProxy -open Emulsion.Settings open Emulsion.TestFramework -open Emulsion.TestFramework.Logging type FileCacheTests(outputHelper: ITestOutputHelper) = let sha256 = SHA256.Create() - let cacheDirectory = lazy ( - let path = Path.GetTempFileName() - File.Delete path - Directory.CreateDirectory path |> ignore - path - ) + let cacheDirectory = lazy TestFileCache.newCacheDirectory() let setUpFileCache(totalLimitBytes: uint64) = - let settings = { - Directory = cacheDirectory.Value - FileSizeLimitBytes = 10UL * 1024UL * 1024UL - TotalCacheSizeLimitBytes = totalLimitBytes - } - - new FileCache(xunitLogger outputHelper, settings, SimpleHttpClientFactory(), sha256) + TestFileCache.setUpFileCache outputHelper sha256 cacheDirectory.Value totalLimitBytes let assertCacheState(entries: (string * byte[]) seq) = let files = @@ -82,6 +69,9 @@ type FileCacheTests(outputHelper: ITestOutputHelper) = return buffer.ToArray() } + interface IDisposable with + member _.Dispose() = sha256.Dispose() + [] member _.``File cache should throw a validation exception if the cache directory contains directories``(): unit = assertCacheValidationError @@ -203,6 +193,3 @@ type FileCacheTests(outputHelper: ITestOutputHelper) = let! content = readAllBytes stream Assert.Equal(fileStorage.Content "a", content) } - - interface IDisposable with - member _.Dispose() = sha256.Dispose() diff --git a/Emulsion.Tests/Web/ContentControllerTests.fs b/Emulsion.Tests/Web/ContentControllerTests.fs index 8a41ada8..0ff0876e 100644 --- a/Emulsion.Tests/Web/ContentControllerTests.fs +++ b/Emulsion.Tests/Web/ContentControllerTests.fs @@ -1,6 +1,7 @@ namespace Emulsion.Tests.Web open System +open System.Security.Cryptography open System.Threading.Tasks open Microsoft.AspNetCore.Mvc @@ -29,25 +30,35 @@ type ContentControllerTests(output: ITestOutputHelper) = let logger = xunitLogger output let telegramClient = TelegramClientMock() - let performTestWithPreparation prepareAction testAction = Async.StartAsTask(async { + let sha256 = SHA256.Create() + + let cacheDirectory = lazy TestFileCache.newCacheDirectory() + + let setUpFileCache(totalLimitBytes: uint64) = + TestFileCache.setUpFileCache output sha256 cacheDirectory.Value totalLimitBytes + + let performTestWithPreparation fileCache prepareAction testAction = Async.StartAsTask(async { return! TestDataStorage.doWithDatabase(fun databaseSettings -> async { do! prepareAction databaseSettings use loggerFactory = new SerilogLoggerFactory(logger) let logger = loggerFactory.CreateLogger() use context = new EmulsionDbContext(databaseSettings.ContextOptions) - let controller = ContentController(logger, hostingSettings, telegramClient, None, context) + let controller = ContentController(logger, hostingSettings, telegramClient, fileCache, context) return! testAction controller }) }) - let performTest = performTestWithPreparation(fun _ -> async.Return()) - let performTestWithContent content = performTestWithPreparation (fun databaseOptions -> async { + let performTest = performTestWithPreparation None (fun _ -> async.Return()) + let performTestWithContent fileCache content = performTestWithPreparation fileCache (fun databaseOptions -> async { use context = new EmulsionDbContext(databaseOptions.ContextOptions) do! DataStorage.addAsync context.TelegramContents content return! Async.Ignore <| Async.AwaitTask(context.SaveChangesAsync()) }) + interface IDisposable with + member _.Dispose() = sha256.Dispose() + [] member _.``ContentController returns BadRequest on hashId deserialization error``(): Task = performTest (fun controller -> async { @@ -57,7 +68,7 @@ type ContentControllerTests(output: ITestOutputHelper) = }) [] - member _.``ContentController returns NotFound if the content doesn't exist``(): Task = + member _.``ContentController returns NotFound if the content doesn't exist in the database``(): Task = performTest (fun controller -> async { let hashId = Proxy.encodeHashId hostingSettings.HashIdSalt 667L let! result = Async.AwaitTask <| controller.Get hashId @@ -76,16 +87,43 @@ type ContentControllerTests(output: ITestOutputHelper) = FileId = "foobar" } - performTestWithContent content (fun controller -> async { + performTestWithContent None content (fun controller -> async { let hashId = Proxy.encodeHashId hostingSettings.HashIdSalt contentId let! result = Async.AwaitTask <| controller.Get hashId let redirect = Assert.IsType result Assert.Equal(Uri $"https://t.me/{chatUserName}/{string messageId}", Uri redirect.Url) }) + [] + member _.``ContentController returns NotFound if the content doesn't exist on the Telegram server``(): Task = task { + let contentId = 344L + let chatUserName = "MySuperExampleChat" + let messageId = 777L + let fileId = "foobar1" + let content = { + Id = contentId + ChatUserName = chatUserName + MessageId = messageId + FileId = fileId + } + + telegramClient.SetResponse(fileId, None) + + let cacheDir = TestFileCache.newCacheDirectory() + use fileCache = TestFileCache.setUpFileCache output sha256 cacheDir 1UL + do! performTestWithContent (Some fileCache) content (fun controller -> async { + let hashId = Proxy.encodeHashId hostingSettings.HashIdSalt contentId + let! result = Async.AwaitTask <| controller.Get hashId + Assert.IsType result |> ignore + }) + } + + [] + member _.``ContentController returns 404 if the cache reports that a file was not found``(): unit = + Assert.True false [] - member _.``ContentController returns a correct result``(): Task = + member _.``ContentController returns a downloaded file from cache``(): Task = let contentId = 343L let chatUserName = "MySuperExampleChat" let messageId = 777L @@ -104,9 +142,11 @@ type ContentControllerTests(output: ITestOutputHelper) = } telegramClient.SetResponse(fileId, Some testFileInfo) - performTestWithContent content (fun controller -> async { + performTestWithContent None content (fun controller -> async { let hashId = Proxy.encodeHashId hostingSettings.HashIdSalt contentId let! result = Async.AwaitTask <| controller.Get hashId let redirect = Assert.IsType result Assert.Equal(testLink, Uri redirect.Url) }) + + From e8e8153c233e2b2c49bb5ac871bcb021caf481df Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sun, 28 Aug 2022 12:45:58 +0200 Subject: [PATCH 13/23] (#102) FileCache: async stream optimization --- Emulsion.ContentProxy/FileCache.fs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/Emulsion.ContentProxy/FileCache.fs b/Emulsion.ContentProxy/FileCache.fs index 8336f4dd..9b485a91 100644 --- a/Emulsion.ContentProxy/FileCache.fs +++ b/Emulsion.ContentProxy/FileCache.fs @@ -46,11 +46,17 @@ type FileCache(logger: ILogger, let getFilePath(cacheKey: string) = Path.Combine(settings.Directory, FileCache.EncodeFileName(sha256, cacheKey)) + let readFileOptions = + FileStreamOptions(Mode = FileMode.Open, Access = FileAccess.Read, Options = FileOptions.Asynchronous, Share = (FileShare.Read ||| FileShare.Delete)) + + let writeFileOptions = + FileStreamOptions(Mode = FileMode.CreateNew, Access = FileAccess.Write, Options = FileOptions.Asynchronous, Share = FileShare.None) + let getFromCache(cacheKey: string) = async { let path = getFilePath cacheKey return if File.Exists path then - Some(new FileStream(path, FileMode.Open, FileAccess.Read, FileShare.Read|||FileShare.Delete)) + Some(new FileStream(path, readFileOptions)) else None } @@ -115,7 +121,7 @@ type FileCache(logger: ILogger, logger.Information("Saving {Uri} to path {Path}…", uri, path) do! async { // to limit the cachedFile scope - use cachedFile = new FileStream(path, FileMode.CreateNew, FileAccess.Write, FileShare.None) + use cachedFile = new FileStream(path, writeFileOptions) do! Async.AwaitTask(stream.CopyToAsync(cachedFile, ct)) logger.Information("Download successful: \"{Uri}\" to \"{Path}\".") } From 067da2d51b3a55d64337a67425bc31117ce33efd Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sun, 28 Aug 2022 12:57:30 +0200 Subject: [PATCH 14/23] (#102) ContentController: add last tests --- .../Emulsion.TestFramework.fsproj | 3 +- .../{TestFileCache.fs => FileCacheUtil.fs} | 2 +- Emulsion.TestFramework/StreamUtils.fs | 10 ++++ Emulsion.TestFramework/WebFileStorage.fs | 4 +- Emulsion.Tests/ContentProxy/FileCacheTests.fs | 14 ++--- Emulsion.Tests/Web/ContentControllerTests.fs | 56 +++++++++++++------ 6 files changed, 60 insertions(+), 29 deletions(-) rename Emulsion.TestFramework/{TestFileCache.fs => FileCacheUtil.fs} (92%) create mode 100644 Emulsion.TestFramework/StreamUtils.fs diff --git a/Emulsion.TestFramework/Emulsion.TestFramework.fsproj b/Emulsion.TestFramework/Emulsion.TestFramework.fsproj index 887232e1..8b0cbe0e 100644 --- a/Emulsion.TestFramework/Emulsion.TestFramework.fsproj +++ b/Emulsion.TestFramework/Emulsion.TestFramework.fsproj @@ -15,7 +15,8 @@ - + + diff --git a/Emulsion.TestFramework/TestFileCache.fs b/Emulsion.TestFramework/FileCacheUtil.fs similarity index 92% rename from Emulsion.TestFramework/TestFileCache.fs rename to Emulsion.TestFramework/FileCacheUtil.fs index b83eedc6..e062a4c8 100644 --- a/Emulsion.TestFramework/TestFileCache.fs +++ b/Emulsion.TestFramework/FileCacheUtil.fs @@ -1,4 +1,4 @@ -module Emulsion.TestFramework.TestFileCache +module Emulsion.TestFramework.FileCacheUtil open System.IO diff --git a/Emulsion.TestFramework/StreamUtils.fs b/Emulsion.TestFramework/StreamUtils.fs new file mode 100644 index 00000000..92fccf1c --- /dev/null +++ b/Emulsion.TestFramework/StreamUtils.fs @@ -0,0 +1,10 @@ +module Emulsion.TestFramework.StreamUtils + +open System.IO + +let readAllBytes(stream: Stream) = async { + use buffer = new MemoryStream() + let! ct = Async.CancellationToken + do! Async.AwaitTask(stream.CopyToAsync(buffer, ct)) + return buffer.ToArray() +} diff --git a/Emulsion.TestFramework/WebFileStorage.fs b/Emulsion.TestFramework/WebFileStorage.fs index 28e3e66a..ad3d886c 100644 --- a/Emulsion.TestFramework/WebFileStorage.fs +++ b/Emulsion.TestFramework/WebFileStorage.fs @@ -20,7 +20,9 @@ type WebFileStorage(data: Map) = let builder = WebApplication.CreateBuilder() let app = builder.Build() app.MapGet("/{entry}", Func<_, _>(fun (entry: string) -> task { - return Results.Bytes(data[entry]) + match Map.tryFind entry data with + | Some bytes -> return Results.Bytes bytes + | None -> return Results.NotFound() })) |> ignore app, app.RunAsync url diff --git a/Emulsion.Tests/ContentProxy/FileCacheTests.fs b/Emulsion.Tests/ContentProxy/FileCacheTests.fs index 724886de..3fbb21f7 100644 --- a/Emulsion.Tests/ContentProxy/FileCacheTests.fs +++ b/Emulsion.Tests/ContentProxy/FileCacheTests.fs @@ -17,10 +17,10 @@ type FileCacheTests(outputHelper: ITestOutputHelper) = let sha256 = SHA256.Create() - let cacheDirectory = lazy TestFileCache.newCacheDirectory() + let cacheDirectory = lazy FileCacheUtil.newCacheDirectory() let setUpFileCache(totalLimitBytes: uint64) = - TestFileCache.setUpFileCache outputHelper sha256 cacheDirectory.Value totalLimitBytes + FileCacheUtil.setUpFileCache outputHelper sha256 cacheDirectory.Value totalLimitBytes let assertCacheState(entries: (string * byte[]) seq) = let files = @@ -63,12 +63,6 @@ type FileCacheTests(outputHelper: ITestOutputHelper) = Assert.Equal(expectedMessage, error.Value.Message) ) - let readAllBytes (stream: Stream) = task { - use buffer = new MemoryStream() - do! stream.CopyToAsync buffer - return buffer.ToArray() - } - interface IDisposable with member _.Dispose() = sha256.Dispose() @@ -164,7 +158,7 @@ type FileCacheTests(outputHelper: ITestOutputHelper) = // Now there's only "b" item in the cache: assertCacheState [| "b", fileStorage.Content "b" |] // We should still be able to read "a" fully: - let! content = readAllBytes stream + let! content = StreamUtils.readAllBytes stream Assert.Equal(fileStorage.Content "a", content) } @@ -190,6 +184,6 @@ type FileCacheTests(outputHelper: ITestOutputHelper) = do! assertFileDownloaded fileCache fileStorage "a" size assertCacheState [| "a", fileStorage.Content "a" |] // We should still be able to read "a" fully: - let! content = readAllBytes stream + let! content = StreamUtils.readAllBytes stream Assert.Equal(fileStorage.Content "a", content) } diff --git a/Emulsion.Tests/Web/ContentControllerTests.fs b/Emulsion.Tests/Web/ContentControllerTests.fs index 0ff0876e..c2817eb2 100644 --- a/Emulsion.Tests/Web/ContentControllerTests.fs +++ b/Emulsion.Tests/Web/ContentControllerTests.fs @@ -29,13 +29,12 @@ type ContentControllerTests(output: ITestOutputHelper) = let logger = xunitLogger output let telegramClient = TelegramClientMock() - let sha256 = SHA256.Create() - let cacheDirectory = lazy TestFileCache.newCacheDirectory() + let cacheDirectory = lazy FileCacheUtil.newCacheDirectory() - let setUpFileCache(totalLimitBytes: uint64) = - TestFileCache.setUpFileCache output sha256 cacheDirectory.Value totalLimitBytes + let setUpFileCache() = + FileCacheUtil.setUpFileCache output sha256 cacheDirectory.Value 0UL let performTestWithPreparation fileCache prepareAction testAction = Async.StartAsTask(async { return! TestDataStorage.doWithDatabase(fun databaseSettings -> async { @@ -109,8 +108,7 @@ type ContentControllerTests(output: ITestOutputHelper) = telegramClient.SetResponse(fileId, None) - let cacheDir = TestFileCache.newCacheDirectory() - use fileCache = TestFileCache.setUpFileCache output sha256 cacheDir 1UL + use fileCache = setUpFileCache() do! performTestWithContent (Some fileCache) content (fun controller -> async { let hashId = Proxy.encodeHashId hostingSettings.HashIdSalt contentId let! result = Async.AwaitTask <| controller.Get hashId @@ -119,11 +117,35 @@ type ContentControllerTests(output: ITestOutputHelper) = } [] - member _.``ContentController returns 404 if the cache reports that a file was not found``(): unit = - Assert.True false + member _.``ContentController returns 404 if the cache reports that a file was not found``(): Task = task { + let contentId = 344L + let chatUserName = "MySuperExampleChat" + let messageId = 777L + let fileId = "foobar1" + let content = { + Id = contentId + ChatUserName = chatUserName + MessageId = messageId + FileId = fileId + } + + + use fileCache = setUpFileCache() + use fileStorage = new WebFileStorage(Map.empty) + telegramClient.SetResponse(fileId, Some { + TemporaryLink = fileStorage.Link fileId + Size = 1UL + }) + + do! performTestWithContent (Some fileCache) content (fun controller -> async { + let hashId = Proxy.encodeHashId hostingSettings.HashIdSalt contentId + let! result = Async.AwaitTask <| controller.Get hashId + Assert.IsType result |> ignore + }) + } [] - member _.``ContentController returns a downloaded file from cache``(): Task = + member _.``ContentController returns a downloaded file from cache``(): Task = task { let contentId = 343L let chatUserName = "MySuperExampleChat" let messageId = 777L @@ -135,18 +157,20 @@ type ContentControllerTests(output: ITestOutputHelper) = FileId = fileId } - let testLink = Uri "https://example.com/myFile" + let onServerFileId = "fileIdOnServer" + use fileCache = setUpFileCache() + use fileStorage = new WebFileStorage(Map.ofArray [| onServerFileId, [| 1uy; 2uy; 3uy |] |]) let testFileInfo = { - TemporaryLink = testLink + TemporaryLink = fileStorage.Link onServerFileId Size = 1UL } telegramClient.SetResponse(fileId, Some testFileInfo) - performTestWithContent None content (fun controller -> async { + do! performTestWithContent (Some fileCache) content (fun controller -> async { let hashId = Proxy.encodeHashId hostingSettings.HashIdSalt contentId let! result = Async.AwaitTask <| controller.Get hashId - let redirect = Assert.IsType result - Assert.Equal(testLink, Uri redirect.Url) + let streamResult = Assert.IsType result + let! content = StreamUtils.readAllBytes streamResult.FileStream + Assert.Equal(fileStorage.Content onServerFileId, content) }) - - + } From 929242850e0311f2d35ed4fa2dbcae69b666c4ad Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sun, 28 Aug 2022 13:25:58 +0200 Subject: [PATCH 15/23] (#102) ContentController: make it work in manual tests --- .../Emulsion.ContentProxy.fsproj | 1 + Emulsion.ContentProxy/FileCache.fs | 5 ++ .../SimpleHttpClientFactory.fs | 2 +- .../Emulsion.TestFramework.fsproj | 1 - Emulsion.Web/WebServer.fs | 3 + Emulsion/Program.fs | 78 +++++++++++-------- 6 files changed, 54 insertions(+), 36 deletions(-) rename {Emulsion.TestFramework => Emulsion.ContentProxy}/SimpleHttpClientFactory.fs (80%) diff --git a/Emulsion.ContentProxy/Emulsion.ContentProxy.fsproj b/Emulsion.ContentProxy/Emulsion.ContentProxy.fsproj index 1f34e60c..55bcfafb 100644 --- a/Emulsion.ContentProxy/Emulsion.ContentProxy.fsproj +++ b/Emulsion.ContentProxy/Emulsion.ContentProxy.fsproj @@ -8,6 +8,7 @@ + diff --git a/Emulsion.ContentProxy/FileCache.fs b/Emulsion.ContentProxy/FileCache.fs index 9b485a91..2d7aec96 100644 --- a/Emulsion.ContentProxy/FileCache.fs +++ b/Emulsion.ContentProxy/FileCache.fs @@ -61,6 +61,10 @@ type FileCache(logger: ILogger, None } + let assertCacheDirectoryExists() = async { + Directory.CreateDirectory settings.Directory |> ignore + } + let assertCacheValid() = async { Directory.EnumerateFileSystemEntries settings.Directory |> Seq.iter(fun entry -> @@ -83,6 +87,7 @@ type FileCache(logger: ILogger, if size > settings.FileSizeLimitBytes || size > settings.TotalCacheSizeLimitBytes then return false else + do! assertCacheDirectoryExists() do! assertCacheValid() let allEntries = diff --git a/Emulsion.TestFramework/SimpleHttpClientFactory.fs b/Emulsion.ContentProxy/SimpleHttpClientFactory.fs similarity index 80% rename from Emulsion.TestFramework/SimpleHttpClientFactory.fs rename to Emulsion.ContentProxy/SimpleHttpClientFactory.fs index e024a00b..01a91ac3 100644 --- a/Emulsion.TestFramework/SimpleHttpClientFactory.fs +++ b/Emulsion.ContentProxy/SimpleHttpClientFactory.fs @@ -1,4 +1,4 @@ -namespace Emulsion.TestFramework +namespace Emulsion.ContentProxy open System.Net.Http diff --git a/Emulsion.TestFramework/Emulsion.TestFramework.fsproj b/Emulsion.TestFramework/Emulsion.TestFramework.fsproj index 8b0cbe0e..a0a6baed 100644 --- a/Emulsion.TestFramework/Emulsion.TestFramework.fsproj +++ b/Emulsion.TestFramework/Emulsion.TestFramework.fsproj @@ -14,7 +14,6 @@ - diff --git a/Emulsion.Web/WebServer.fs b/Emulsion.Web/WebServer.fs index b015c557..0953f9ab 100644 --- a/Emulsion.Web/WebServer.fs +++ b/Emulsion.Web/WebServer.fs @@ -6,6 +6,7 @@ open Microsoft.AspNetCore.Builder open Microsoft.Extensions.DependencyInjection open Serilog +open Emulsion.ContentProxy open Emulsion.Database open Emulsion.Settings open Emulsion.Telegram @@ -14,6 +15,7 @@ let run (logger: ILogger) (hostingSettings: HostingSettings) (databaseSettings: DatabaseSettings) (telegram: ITelegramClient) + (fileCache: FileCache option) : Task = let builder = WebApplication.CreateBuilder(WebApplicationOptions()) @@ -23,6 +25,7 @@ let run (logger: ILogger) builder.Services .AddSingleton(hostingSettings) .AddSingleton(telegram) + .AddSingleton(fileCache) .AddTransient(fun _ -> new EmulsionDbContext(databaseSettings.ContextOptions)) .AddControllers() .AddApplicationPart(typeof.Assembly) diff --git a/Emulsion/Program.fs b/Emulsion/Program.fs index c49295e3..3ed1e544 100644 --- a/Emulsion/Program.fs +++ b/Emulsion/Program.fs @@ -2,12 +2,14 @@ open System open System.IO +open System.Security.Cryptography open Akka.Actor open Microsoft.Extensions.Configuration open Serilog open Emulsion.Actors +open Emulsion.ContentProxy open Emulsion.Database open Emulsion.Messaging.MessageSystem open Emulsion.Settings @@ -58,42 +60,50 @@ let private startApp config = config.Database, config.Hosting) - match config.Database with - | Some dbSettings -> do! migrateDatabase logger dbSettings - | None -> () - - let webServerTask = - match config.Hosting, config.Database with - | Some hosting, Some database -> - logger.Information "Initializing web server…" - Some <| WebServer.run logger hosting database telegram - | _ -> None - - logger.Information "Actor system preparation…" - use system = ActorSystem.Create("emulsion") - logger.Information "Clients preparation…" - - let factories = { xmppFactory = Xmpp.spawn xmppLogger xmpp - telegramFactory = Telegram.spawn telegramLogger telegram } - logger.Information "Core preparation…" - let core = Core.spawn logger factories system "core" - logger.Information "Message systems preparation…" - let! telegramSystem = startMessageSystem logger telegram core.Tell - let! xmppSystem = startMessageSystem logger xmpp core.Tell - logger.Information "System ready" - - logger.Information "Waiting for the systems to terminate…" - let! _ = Async.Parallel(seq { - yield Async.AwaitTask system.WhenTerminated - yield telegramSystem - yield xmppSystem - - match webServerTask with - | Some task -> yield Async.AwaitTask task + use sha256 = SHA256.Create() + let fileCacheOption = config.FileCache |> Option.map(fun settings -> + let httpClientFactory = SimpleHttpClientFactory() + new FileCache(logger, settings, httpClientFactory, sha256) + ) + + try + match config.Database with + | Some dbSettings -> do! migrateDatabase logger dbSettings | None -> () - }) - logger.Information "Terminated successfully." + let webServerTask = + match config.Hosting, config.Database with + | Some hosting, Some database -> + logger.Information "Initializing the web server…" + Some <| WebServer.run logger hosting database telegram fileCacheOption + | _ -> None + + logger.Information "Actor system preparation…" + use system = ActorSystem.Create("emulsion") + logger.Information "Clients preparation…" + + let factories = { xmppFactory = Xmpp.spawn xmppLogger xmpp + telegramFactory = Telegram.spawn telegramLogger telegram } + logger.Information "Core preparation…" + let core = Core.spawn logger factories system "core" + logger.Information "Message systems preparation…" + let! telegramSystem = startMessageSystem logger telegram core.Tell + let! xmppSystem = startMessageSystem logger xmpp core.Tell + logger.Information "System ready" + + logger.Information "Waiting for the systems to terminate…" + do! Async.Ignore <| Async.Parallel(seq { + yield Async.AwaitTask system.WhenTerminated + yield telegramSystem + yield xmppSystem + + match webServerTask with + | Some task -> yield Async.AwaitTask task + | None -> () + }) + finally + fileCacheOption |> Option.iter(fun x -> (x :> IDisposable).Dispose()) + logger.Information "Terminated successfully." with | error -> logger.Fatal(error, "General application failure") From b02512c4d3cfdaf60aca2c87f2d35745e12e328b Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sun, 28 Aug 2022 13:38:06 +0200 Subject: [PATCH 16/23] (#102) ContentProxy: some small fixes --- Emulsion.ContentProxy/FileCache.fs | 2 +- Emulsion.Settings/Settings.fs | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/Emulsion.ContentProxy/FileCache.fs b/Emulsion.ContentProxy/FileCache.fs index 2d7aec96..425244ba 100644 --- a/Emulsion.ContentProxy/FileCache.fs +++ b/Emulsion.ContentProxy/FileCache.fs @@ -128,7 +128,7 @@ type FileCache(logger: ILogger, do! async { // to limit the cachedFile scope use cachedFile = new FileStream(path, writeFileOptions) do! Async.AwaitTask(stream.CopyToAsync(cachedFile, ct)) - logger.Information("Download successful: \"{Uri}\" to \"{Path}\".") + logger.Information("Download successful: \"{Uri}\" to \"{Path}\".", uri, path) } let! file = getFromCache cacheKey diff --git a/Emulsion.Settings/Settings.fs b/Emulsion.Settings/Settings.fs index db034f20..511f23e8 100644 --- a/Emulsion.Settings/Settings.fs +++ b/Emulsion.Settings/Settings.fs @@ -108,8 +108,8 @@ let read (config : IConfiguration) : EmulsionSettings = Option.ofObj section["directory"] |> Option.map(fun directory -> { Directory = directory - FileSizeLimitBytes = uint64OrDefault section["fileSizeLimitBytes"] 1024UL * 1024UL - TotalCacheSizeLimitBytes = uint64OrDefault section["fileSizeLimitBytes"] 20UL * 1024UL * 1024UL + FileSizeLimitBytes = uint64OrDefault section["fileSizeLimitBytes"] (1024UL * 1024UL) + TotalCacheSizeLimitBytes = uint64OrDefault section["totalCacheSizeLimitBytes"] (20UL * 1024UL * 1024UL) }) { Xmpp = readXmpp <| config.GetSection("xmpp") From 5d954d65fefbe202794ad21ebcb57512802ee405 Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sun, 28 Aug 2022 14:40:17 +0200 Subject: [PATCH 17/23] (#102) ContentProxy: add file names and MIME types --- Emulsion.ContentProxy/ContentStorage.fs | 8 +- Emulsion.Database/EmulsionDbContext.fs | 4 + Emulsion.Database/Entities.fs | 2 + .../20220828121717_FileNameAndMimeType.fs | 77 +++++++++++++++++++ .../EmulsionDbContextModelSnapshot.fs | 9 ++- Emulsion.Telegram/LinkGenerator.fs | 69 ++++++++++++----- .../ContentProxy/ContentStorageTests.fs | 2 + .../Database/DatabaseStructureTests.fs | 2 + Emulsion.Tests/Web/ContentControllerTests.fs | 9 ++- Emulsion.Web/ContentController.fs | 4 +- docs/create-migration.md | 2 +- 11 files changed, 163 insertions(+), 25 deletions(-) create mode 100644 Emulsion.Database/Migrations/20220828121717_FileNameAndMimeType.fs diff --git a/Emulsion.ContentProxy/ContentStorage.fs b/Emulsion.ContentProxy/ContentStorage.fs index 11604e17..b2073bed 100644 --- a/Emulsion.ContentProxy/ContentStorage.fs +++ b/Emulsion.ContentProxy/ContentStorage.fs @@ -9,6 +9,8 @@ type MessageContentIdentity = { ChatUserName: string MessageId: int64 FileId: string + FileName: string option + MimeType: string option } let getOrCreateMessageRecord (context: EmulsionDbContext) (id: MessageContentIdentity): Async = async { @@ -17,7 +19,9 @@ let getOrCreateMessageRecord (context: EmulsionDbContext) (id: MessageContentIde for content in context.TelegramContents do where (content.ChatUserName = id.ChatUserName && content.MessageId = id.MessageId - && content.FileId = id.FileId) + && content.FileId = id.FileId + && content.FileName = id.FileName + && content.MimeType = id.MimeType) } |> tryExactlyOneAsync match existingItem with | None -> @@ -26,6 +30,8 @@ let getOrCreateMessageRecord (context: EmulsionDbContext) (id: MessageContentIde ChatUserName = id.ChatUserName MessageId = id.MessageId FileId = id.FileId + FileName = id.FileName + MimeType = id.MimeType } do! addAsync context.TelegramContents newItem return newItem diff --git a/Emulsion.Database/EmulsionDbContext.fs b/Emulsion.Database/EmulsionDbContext.fs index 848de3e4..b2c913f2 100644 --- a/Emulsion.Database/EmulsionDbContext.fs +++ b/Emulsion.Database/EmulsionDbContext.fs @@ -1,5 +1,6 @@ namespace Emulsion.Database +open EntityFrameworkCore.FSharp.Extensions open Microsoft.EntityFrameworkCore open Microsoft.EntityFrameworkCore.Design @@ -8,6 +9,9 @@ open Emulsion.Database.Entities type EmulsionDbContext(options: DbContextOptions) = inherit DbContext(options) + override _.OnModelCreating builder = + builder.RegisterOptionTypes() + [] val mutable private telegramContents: DbSet member this.TelegramContents with get() = this.telegramContents and set v = this.telegramContents <- v diff --git a/Emulsion.Database/Entities.fs b/Emulsion.Database/Entities.fs index aa6b57c9..5f3598fd 100644 --- a/Emulsion.Database/Entities.fs +++ b/Emulsion.Database/Entities.fs @@ -8,4 +8,6 @@ type TelegramContent = { ChatUserName: string MessageId: int64 FileId: string + FileName: string option + MimeType: string option } diff --git a/Emulsion.Database/Migrations/20220828121717_FileNameAndMimeType.fs b/Emulsion.Database/Migrations/20220828121717_FileNameAndMimeType.fs new file mode 100644 index 00000000..cb72f12c --- /dev/null +++ b/Emulsion.Database/Migrations/20220828121717_FileNameAndMimeType.fs @@ -0,0 +1,77 @@ +// +namespace Emulsion.Database.Migrations + +open System +open Emulsion.Database +open Microsoft.EntityFrameworkCore +open Microsoft.EntityFrameworkCore.Infrastructure +open Microsoft.EntityFrameworkCore.Metadata +open Microsoft.EntityFrameworkCore.Migrations +open Microsoft.EntityFrameworkCore.Storage.ValueConversion + +[)>] +[] +type FileNameAndMimeType() = + inherit Migration() + + override this.Up(migrationBuilder:MigrationBuilder) = + migrationBuilder.AddColumn( + name = "FileName" + ,table = "TelegramContents" + ,``type`` = "TEXT" + ,nullable = true + ) |> ignore + + migrationBuilder.AddColumn( + name = "MimeType" + ,table = "TelegramContents" + ,``type`` = "TEXT" + ,nullable = true + ) |> ignore + + + override this.Down(migrationBuilder:MigrationBuilder) = + migrationBuilder.DropColumn( + name = "FileName" + ,table = "TelegramContents" + ) |> ignore + + migrationBuilder.DropColumn( + name = "MimeType" + ,table = "TelegramContents" + ) |> ignore + + + override this.BuildTargetModel(modelBuilder: ModelBuilder) = + modelBuilder + .HasAnnotation("ProductVersion", "5.0.10") + |> ignore + + modelBuilder.Entity("Emulsion.Database.Entities.TelegramContent", (fun b -> + + b.Property("Id") + .IsRequired(true) + .ValueGeneratedOnAdd() + .HasColumnType("INTEGER") |> ignore + b.Property("ChatUserName") + .IsRequired(false) + .HasColumnType("TEXT") |> ignore + b.Property("FileId") + .IsRequired(false) + .HasColumnType("TEXT") |> ignore + b.Property("FileName") + .IsRequired(false) + .HasColumnType("TEXT") |> ignore + b.Property("MessageId") + .IsRequired(true) + .HasColumnType("INTEGER") |> ignore + b.Property("MimeType") + .IsRequired(false) + .HasColumnType("TEXT") |> ignore + + b.HasKey("Id") |> ignore + + b.ToTable("TelegramContents") |> ignore + + )) |> ignore + diff --git a/Emulsion.Database/Migrations/EmulsionDbContextModelSnapshot.fs b/Emulsion.Database/Migrations/EmulsionDbContextModelSnapshot.fs index f2fd07d8..2bf566aa 100644 --- a/Emulsion.Database/Migrations/EmulsionDbContextModelSnapshot.fs +++ b/Emulsion.Database/Migrations/EmulsionDbContextModelSnapshot.fs @@ -5,9 +5,6 @@ open System open Emulsion.Database open Microsoft.EntityFrameworkCore open Microsoft.EntityFrameworkCore.Infrastructure -open Microsoft.EntityFrameworkCore.Metadata -open Microsoft.EntityFrameworkCore.Migrations -open Microsoft.EntityFrameworkCore.Storage.ValueConversion [)>] type EmulsionDbContextModelSnapshot() = @@ -30,9 +27,15 @@ type EmulsionDbContextModelSnapshot() = b.Property("FileId") .IsRequired(false) .HasColumnType("TEXT") |> ignore + b.Property("FileName") + .IsRequired(false) + .HasColumnType("TEXT") |> ignore b.Property("MessageId") .IsRequired(true) .HasColumnType("INTEGER") |> ignore + b.Property("MimeType") + .IsRequired(false) + .HasColumnType("TEXT") |> ignore b.HasKey("Id") |> ignore diff --git a/Emulsion.Telegram/LinkGenerator.fs b/Emulsion.Telegram/LinkGenerator.fs index 8be513e9..0f79469b 100644 --- a/Emulsion.Telegram/LinkGenerator.fs +++ b/Emulsion.Telegram/LinkGenerator.fs @@ -30,41 +30,74 @@ let private gatherMessageLink(message: FunogramMessage) = | { Text = Some _} | { Poll = Some _ } -> None | _ -> getMessageLink message -let private getFileIds(message: FunogramMessage): string seq = - let allFileIds = ResizeArray() - let inline extractFileId(o: ^a option) = - Option.iter(fun o -> allFileIds.Add((^a) : (member FileId: string) o)) o +type private FileInfo = { + FileId: string + FileName: string option + MimeType: string option +} + +let private getFileInfos(message: FunogramMessage): FileInfo seq = + let allFileInfos = ResizeArray() + let inline extractFileInfo(o: ^a option) = + o |> Option.iter(fun o -> + allFileInfos.Add({ + FileId = ((^a) : (member FileId: string) o) + FileName = ((^a) : (member FileName: string option) o) + MimeType = ((^a) : (member MimeType: string option) o) + })) + + let inline extractFileInfoWithName (fileName: string) (o: ^a option) = + o |> Option.iter(fun o -> + allFileInfos.Add({ + FileId = ((^a) : (member FileId: string) o) + FileName = Some fileName + MimeType = ((^a) : (member MimeType: string option) o) + })) - let extractPhotoFileId: PhotoSize[] option -> unit = + let inline extractFileInfoWithNameAndMimeType (fileName: string) (mimeType: string) (o: ^a option) = + o |> Option.iter(fun o -> + allFileInfos.Add({ + FileId = ((^a) : (member FileId: string) o) + FileName = Some fileName + MimeType = Some mimeType + })) + + let extractPhotoFileInfo: PhotoSize[] option -> unit = Option.iter( // Telegram may send several differently-sized thumbnails in one message. Pick the biggest one of them. Seq.sortByDescending(fun size -> size.Height * size.Width) >> Seq.map(fun photoSize -> photoSize.FileId) >> Seq.tryHead - >> Option.iter(allFileIds.Add) + >> Option.iter(fun fileId -> allFileInfos.Add { + FileId = fileId + FileName = Some "photo.jpg" + MimeType = Some "image/jpeg" + }) ) - extractFileId message.Document - extractFileId message.Audio - extractFileId message.Animation - extractPhotoFileId message.Photo - extractFileId message.Sticker - extractFileId message.Video - extractFileId message.Voice - extractFileId message.VideoNote + extractFileInfo message.Document + extractFileInfo message.Audio + extractFileInfo message.Animation + extractPhotoFileInfo message.Photo + extractFileInfoWithNameAndMimeType "sticker.jpg" "image/jpeg" message.Sticker + extractFileInfo message.Video + extractFileInfoWithName "voice.ogg" message.Voice + extractFileInfoWithNameAndMimeType "video.mp4" "video/mp4" message.VideoNote - allFileIds + allFileInfos let private getContentIdentities(message: FunogramMessage): ContentStorage.MessageContentIdentity seq = match message.Chat with | { Type = SuperGroup Username = Some chatName } -> - getFileIds message - |> Seq.map (fun fileId -> + getFileInfos message + |> Seq.map (fun fileInfo -> { ChatUserName = chatName MessageId = message.MessageId - FileId = fileId + FileId = fileInfo.FileId + FileName = fileInfo.FileName + MimeType = fileInfo.MimeType } ) | _ -> Seq.empty diff --git a/Emulsion.Tests/ContentProxy/ContentStorageTests.fs b/Emulsion.Tests/ContentProxy/ContentStorageTests.fs index 40044506..86276d16 100644 --- a/Emulsion.Tests/ContentProxy/ContentStorageTests.fs +++ b/Emulsion.Tests/ContentProxy/ContentStorageTests.fs @@ -10,6 +10,8 @@ let private testIdentity = { ChatUserName = "test" MessageId = 123L FileId = "this_is_file" + FileName = None + MimeType = None } let private executeQuery settings = diff --git a/Emulsion.Tests/Database/DatabaseStructureTests.fs b/Emulsion.Tests/Database/DatabaseStructureTests.fs index 1bb3f101..50c06362 100644 --- a/Emulsion.Tests/Database/DatabaseStructureTests.fs +++ b/Emulsion.Tests/Database/DatabaseStructureTests.fs @@ -16,6 +16,8 @@ let ``Unique constraint should hold``(): unit = ChatUserName = "testChat" MessageId = 666L FileId = "foobar" + FileName = None + MimeType = None } async { do! DataStorage.addAsync ctx.TelegramContents newContent diff --git a/Emulsion.Tests/Web/ContentControllerTests.fs b/Emulsion.Tests/Web/ContentControllerTests.fs index c2817eb2..10dae87e 100644 --- a/Emulsion.Tests/Web/ContentControllerTests.fs +++ b/Emulsion.Tests/Web/ContentControllerTests.fs @@ -84,6 +84,8 @@ type ContentControllerTests(output: ITestOutputHelper) = ChatUserName = chatUserName MessageId = messageId FileId = "foobar" + FileName = None + MimeType = None } performTestWithContent None content (fun controller -> async { @@ -104,6 +106,8 @@ type ContentControllerTests(output: ITestOutputHelper) = ChatUserName = chatUserName MessageId = messageId FileId = fileId + FileName = None + MimeType = None } telegramClient.SetResponse(fileId, None) @@ -127,9 +131,10 @@ type ContentControllerTests(output: ITestOutputHelper) = ChatUserName = chatUserName MessageId = messageId FileId = fileId + FileName = None + MimeType = None } - use fileCache = setUpFileCache() use fileStorage = new WebFileStorage(Map.empty) telegramClient.SetResponse(fileId, Some { @@ -155,6 +160,8 @@ type ContentControllerTests(output: ITestOutputHelper) = ChatUserName = chatUserName MessageId = messageId FileId = fileId + FileName = None + MimeType = None } let onServerFileId = "fileIdOnServer" diff --git a/Emulsion.Web/ContentController.fs b/Emulsion.Web/ContentController.fs index e7a0bbe2..062927f9 100644 --- a/Emulsion.Web/ContentController.fs +++ b/Emulsion.Web/ContentController.fs @@ -55,5 +55,7 @@ type ContentController(logger: ILogger, logger.LogWarning $"Link \"{fileInfo}\" could not be downloaded." return this.NotFound() :> IActionResult | Some stream -> - return FileStreamResult(stream, "application/octet-stream") + let contentType = Option.defaultValue "application/octet-stream" content.MimeType + let fileName = Option.defaultValue "" content.FileName + return FileStreamResult(stream, contentType, FileDownloadName = fileName) } diff --git a/docs/create-migration.md b/docs/create-migration.md index e689820f..a08ed419 100644 --- a/docs/create-migration.md +++ b/docs/create-migration.md @@ -3,7 +3,7 @@ This article explains how to create a database migration using [EFCore.FSharp][efcore.fsharp]. -1. Change the entity type (see `Emulsion.Database/Models.fs`), update the `EmulsionDbContext` if required. +1. Change the entity type (see `Emulsion.Database/Entities.fs`), update the `EmulsionDbContext` if required. 2. Run the following shell commands: ```console From 3977248a9258536b2ca208e85143ec9e481fc45b Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sun, 28 Aug 2022 15:08:52 +0200 Subject: [PATCH 18/23] (#102) FileCache: support older versions of Windows --- Emulsion.ContentProxy/FileCache.fs | 26 +++++++++++++++++++++++++- 1 file changed, 25 insertions(+), 1 deletion(-) diff --git a/Emulsion.ContentProxy/FileCache.fs b/Emulsion.ContentProxy/FileCache.fs index 425244ba..005cacc4 100644 --- a/Emulsion.ContentProxy/FileCache.fs +++ b/Emulsion.ContentProxy/FileCache.fs @@ -83,6 +83,30 @@ type FileCache(logger: ILogger, ) } + let deleteFileSafe (fileInfo: FileInfo) = async { + if OperatingSystem.IsWindows() then + // NOTE: On older versions of Windows (known to reproduce on windows-2019 GitHub Actions image), the + // following scenario may be defunct: + // - open a file with FileShare.Delete (i.e. for download) + // - delete a file (i.e. during the cache cleanup) + // - try to create a file with the same name again + // + // According to this article + // (https://boostgsoc13.github.io/boost.afio/doc/html/afio/FAQ/deleting_open_files.html), it is impossible + // to do since file will occupy its disk name until the last handle is closed. + // + // In practice, this is allowed (checked at least on Windows 10 20H2 and windows-2022 GitHub Actions image), + // but is known to be broken on older versions of Windows (windows-2019). + // + // As a workaround, let's rename the file to a random name before deleting it. + // + // This workaround may be removed after these older versions of Windows goes out of support. + fileInfo.MoveTo(Path.Combine(fileInfo.DirectoryName, $"{Guid.NewGuid().ToString()}.deleted")) + fileInfo.Delete() + else + fileInfo.Delete() + } + let ensureFreeCache size = async { if size > settings.FileSizeLimitBytes || size > settings.TotalCacheSizeLimitBytes then return false @@ -106,7 +130,7 @@ type FileCache(logger: ILogger, currentSize <- currentSize + Checked.uint64 info.Length if currentSize + size > settings.TotalCacheSizeLimitBytes then logger.Information("Deleting a cache item \"{FileName}\" ({Size} bytes)", info.Name, info.Length) - info.Delete() + do! deleteFileSafe info return true } From fb5dc3a775ead88925df430c386d53583c94b5a4 Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sun, 28 Aug 2022 15:12:45 +0200 Subject: [PATCH 19/23] Docs: a slight improvement --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 270b19fa..8755dc8d 100644 --- a/README.md +++ b/README.md @@ -125,7 +125,7 @@ where - `$EMULSION_VERSION` is the image version you want to deploy, or `latest` for the latest available one - `$CONFIG` is the **absolute** path to the configuration file -- `$DATA` is the absolute path to the data directory +- `$DATA` is the absolute path to the data directory (used by the configuration) - `$WEB_PORT` is the port on the host system which will be used to access the content proxy To build and push the container to Docker Hub, use the following commands: From a58f54ee504ed37aff777b2f9ea550d671fae471 Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sun, 28 Aug 2022 15:15:32 +0200 Subject: [PATCH 20/23] (#102) FileCache: drop redundant rec --- Emulsion.ContentProxy/FileCache.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Emulsion.ContentProxy/FileCache.fs b/Emulsion.ContentProxy/FileCache.fs index 005cacc4..2339aeba 100644 --- a/Emulsion.ContentProxy/FileCache.fs +++ b/Emulsion.ContentProxy/FileCache.fs @@ -180,7 +180,7 @@ type FileCache(logger: ILogger, return result } - let rec processLoop(processor: MailboxProcessor<_ * AsyncReplyChannel<_>>) = async { + let processLoop(processor: MailboxProcessor<_ * AsyncReplyChannel<_>>) = async { while true do let! request, replyChannel = processor.Receive() try From b2cccee77b8cd6a53872fb0f4e8a823011a45d0e Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sun, 28 Aug 2022 15:20:14 +0200 Subject: [PATCH 21/23] (#102) FileCache: improve the workarounds for the older versions of Windows --- Emulsion.ContentProxy/FileCache.fs | 65 +++++++++++-------- Emulsion.Tests/ContentProxy/FileCacheTests.fs | 4 ++ 2 files changed, 41 insertions(+), 28 deletions(-) diff --git a/Emulsion.ContentProxy/FileCache.fs b/Emulsion.ContentProxy/FileCache.fs index 2339aeba..73a303e7 100644 --- a/Emulsion.ContentProxy/FileCache.fs +++ b/Emulsion.ContentProxy/FileCache.fs @@ -36,6 +36,26 @@ module FileCache = with | :? ArgumentException -> None + let IsMoveAndDeleteModeEnabled = + // NOTE: On older versions of Windows (known to reproduce on windows-2019 GitHub Actions image), the following + // scenario may be defunct: + // + // - open a file with FileShare.Delete (i.e. for download) + // - delete a file (i.e. during the cache cleanup) + // - try to create a file with the same name again + // + // According to this article + // (https://boostgsoc13.github.io/boost.afio/doc/html/afio/FAQ/deleting_open_files.html), it is impossible to do + // since file will occupy its disk name until the last handle is closed. + // + // In practice, this is allowed (checked at least on Windows 10 20H2 and windows-2022 GitHub Actions image), but + // some tests are known to be broken on older versions of Windows (windows-2019). + // + // As a workaround, let's rename the file to a random name before deleting it. + // + // This workaround may be removed after these older versions of Windows goes out of support. + OperatingSystem.IsWindows() + type FileCache(logger: ILogger, settings: FileCacheSettings, httpClientFactory: IHttpClientFactory, @@ -61,12 +81,27 @@ type FileCache(logger: ILogger, None } + let enumerateCacheFiles() = + let entries = Directory.EnumerateFileSystemEntries settings.Directory + if FileCache.IsMoveAndDeleteModeEnabled then + entries |> Seq.filter(fun p -> not(p.EndsWith ".deleted")) + else + entries + + let deleteFileSafe (fileInfo: FileInfo) = async { + if FileCache.IsMoveAndDeleteModeEnabled then + fileInfo.MoveTo(Path.Combine(fileInfo.DirectoryName, $"{Guid.NewGuid().ToString()}.deleted")) + fileInfo.Delete() + else + fileInfo.Delete() + } + let assertCacheDirectoryExists() = async { Directory.CreateDirectory settings.Directory |> ignore } let assertCacheValid() = async { - Directory.EnumerateFileSystemEntries settings.Directory + enumerateCacheFiles() |> Seq.iter(fun entry -> let entryName = Path.GetFileName entry @@ -83,30 +118,6 @@ type FileCache(logger: ILogger, ) } - let deleteFileSafe (fileInfo: FileInfo) = async { - if OperatingSystem.IsWindows() then - // NOTE: On older versions of Windows (known to reproduce on windows-2019 GitHub Actions image), the - // following scenario may be defunct: - // - open a file with FileShare.Delete (i.e. for download) - // - delete a file (i.e. during the cache cleanup) - // - try to create a file with the same name again - // - // According to this article - // (https://boostgsoc13.github.io/boost.afio/doc/html/afio/FAQ/deleting_open_files.html), it is impossible - // to do since file will occupy its disk name until the last handle is closed. - // - // In practice, this is allowed (checked at least on Windows 10 20H2 and windows-2022 GitHub Actions image), - // but is known to be broken on older versions of Windows (windows-2019). - // - // As a workaround, let's rename the file to a random name before deleting it. - // - // This workaround may be removed after these older versions of Windows goes out of support. - fileInfo.MoveTo(Path.Combine(fileInfo.DirectoryName, $"{Guid.NewGuid().ToString()}.deleted")) - fileInfo.Delete() - else - fileInfo.Delete() - } - let ensureFreeCache size = async { if size > settings.FileSizeLimitBytes || size > settings.TotalCacheSizeLimitBytes then return false @@ -114,9 +125,7 @@ type FileCache(logger: ILogger, do! assertCacheDirectoryExists() do! assertCacheValid() - let allEntries = - Directory.EnumerateFileSystemEntries settings.Directory - |> Seq.map FileInfo + let allEntries = enumerateCacheFiles() |> Seq.map FileInfo // Now, sort the entries from newest to oldest, and start deleting if required at a point when we understand // that there are too much files: diff --git a/Emulsion.Tests/ContentProxy/FileCacheTests.fs b/Emulsion.Tests/ContentProxy/FileCacheTests.fs index 3fbb21f7..0548d17f 100644 --- a/Emulsion.Tests/ContentProxy/FileCacheTests.fs +++ b/Emulsion.Tests/ContentProxy/FileCacheTests.fs @@ -25,6 +25,10 @@ type FileCacheTests(outputHelper: ITestOutputHelper) = let assertCacheState(entries: (string * byte[]) seq) = let files = Directory.EnumerateFileSystemEntries(cacheDirectory.Value) + |> Seq.filter(fun f -> + if FileCache.IsMoveAndDeleteModeEnabled then not(f.EndsWith ".deleted") + else true + ) |> Seq.map(fun file -> let name = Path.GetFileName file let content = File.ReadAllBytes file From 2861ee881e36daebc162f1505431e3ee55adcce4 Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sun, 28 Aug 2022 15:43:27 +0200 Subject: [PATCH 22/23] (#102) ContentProxy: redesign the attribute optionality --- Emulsion.ContentProxy/ContentStorage.fs | 4 +-- Emulsion.Database/EmulsionDbContext.fs | 4 --- Emulsion.Database/Entities.fs | 4 +-- ...20828133844_ContentFileNameAndMimeType.fs} | 26 ++++++++++++++----- .../EmulsionDbContextModelSnapshot.fs | 4 +-- Emulsion.Telegram/LinkGenerator.fs | 4 +-- .../ContentProxy/ContentStorageTests.fs | 4 +-- .../Database/DatabaseStructureTests.fs | 4 +-- Emulsion.Tests/Web/ContentControllerTests.fs | 16 ++++++------ Emulsion.Web/ContentController.fs | 4 +-- 10 files changed, 41 insertions(+), 33 deletions(-) rename Emulsion.Database/Migrations/{20220828121717_FileNameAndMimeType.fs => 20220828133844_ContentFileNameAndMimeType.fs} (74%) diff --git a/Emulsion.ContentProxy/ContentStorage.fs b/Emulsion.ContentProxy/ContentStorage.fs index b2073bed..3f05ed68 100644 --- a/Emulsion.ContentProxy/ContentStorage.fs +++ b/Emulsion.ContentProxy/ContentStorage.fs @@ -9,8 +9,8 @@ type MessageContentIdentity = { ChatUserName: string MessageId: int64 FileId: string - FileName: string option - MimeType: string option + FileName: string + MimeType: string } let getOrCreateMessageRecord (context: EmulsionDbContext) (id: MessageContentIdentity): Async = async { diff --git a/Emulsion.Database/EmulsionDbContext.fs b/Emulsion.Database/EmulsionDbContext.fs index b2c913f2..848de3e4 100644 --- a/Emulsion.Database/EmulsionDbContext.fs +++ b/Emulsion.Database/EmulsionDbContext.fs @@ -1,6 +1,5 @@ namespace Emulsion.Database -open EntityFrameworkCore.FSharp.Extensions open Microsoft.EntityFrameworkCore open Microsoft.EntityFrameworkCore.Design @@ -9,9 +8,6 @@ open Emulsion.Database.Entities type EmulsionDbContext(options: DbContextOptions) = inherit DbContext(options) - override _.OnModelCreating builder = - builder.RegisterOptionTypes() - [] val mutable private telegramContents: DbSet member this.TelegramContents with get() = this.telegramContents and set v = this.telegramContents <- v diff --git a/Emulsion.Database/Entities.fs b/Emulsion.Database/Entities.fs index 5f3598fd..db9b169e 100644 --- a/Emulsion.Database/Entities.fs +++ b/Emulsion.Database/Entities.fs @@ -8,6 +8,6 @@ type TelegramContent = { ChatUserName: string MessageId: int64 FileId: string - FileName: string option - MimeType: string option + FileName: string + MimeType: string } diff --git a/Emulsion.Database/Migrations/20220828121717_FileNameAndMimeType.fs b/Emulsion.Database/Migrations/20220828133844_ContentFileNameAndMimeType.fs similarity index 74% rename from Emulsion.Database/Migrations/20220828121717_FileNameAndMimeType.fs rename to Emulsion.Database/Migrations/20220828133844_ContentFileNameAndMimeType.fs index cb72f12c..93b73de9 100644 --- a/Emulsion.Database/Migrations/20220828121717_FileNameAndMimeType.fs +++ b/Emulsion.Database/Migrations/20220828133844_ContentFileNameAndMimeType.fs @@ -5,13 +5,11 @@ open System open Emulsion.Database open Microsoft.EntityFrameworkCore open Microsoft.EntityFrameworkCore.Infrastructure -open Microsoft.EntityFrameworkCore.Metadata open Microsoft.EntityFrameworkCore.Migrations -open Microsoft.EntityFrameworkCore.Storage.ValueConversion [)>] -[] -type FileNameAndMimeType() = +[] +type ContentFileNameAndMimeType() = inherit Migration() override this.Up(migrationBuilder:MigrationBuilder) = @@ -20,6 +18,7 @@ type FileNameAndMimeType() = ,table = "TelegramContents" ,``type`` = "TEXT" ,nullable = true + ,defaultValue = "file.bin" ) |> ignore migrationBuilder.AddColumn( @@ -27,8 +26,16 @@ type FileNameAndMimeType() = ,table = "TelegramContents" ,``type`` = "TEXT" ,nullable = true + ,defaultValue = "application/octet-stream" ) |> ignore + migrationBuilder.Sql @" + drop index TelegramContents_Unique; + + create unique index TelegramContents_Unique + on TelegramContents(ChatUserName, MessageId, FileId, FileName, MimeType) + " |> ignore + override this.Down(migrationBuilder:MigrationBuilder) = migrationBuilder.DropColumn( @@ -41,6 +48,13 @@ type FileNameAndMimeType() = ,table = "TelegramContents" ) |> ignore + migrationBuilder.Sql @" + drop index TelegramContents_Unique; + + create unique index TelegramContents_Unique + on TelegramContents(ChatUserName, MessageId, FileId) + " |> ignore + override this.BuildTargetModel(modelBuilder: ModelBuilder) = modelBuilder @@ -59,13 +73,13 @@ type FileNameAndMimeType() = b.Property("FileId") .IsRequired(false) .HasColumnType("TEXT") |> ignore - b.Property("FileName") + b.Property("FileName") .IsRequired(false) .HasColumnType("TEXT") |> ignore b.Property("MessageId") .IsRequired(true) .HasColumnType("INTEGER") |> ignore - b.Property("MimeType") + b.Property("MimeType") .IsRequired(false) .HasColumnType("TEXT") |> ignore diff --git a/Emulsion.Database/Migrations/EmulsionDbContextModelSnapshot.fs b/Emulsion.Database/Migrations/EmulsionDbContextModelSnapshot.fs index 2bf566aa..2e930df8 100644 --- a/Emulsion.Database/Migrations/EmulsionDbContextModelSnapshot.fs +++ b/Emulsion.Database/Migrations/EmulsionDbContextModelSnapshot.fs @@ -27,13 +27,13 @@ type EmulsionDbContextModelSnapshot() = b.Property("FileId") .IsRequired(false) .HasColumnType("TEXT") |> ignore - b.Property("FileName") + b.Property("FileName") .IsRequired(false) .HasColumnType("TEXT") |> ignore b.Property("MessageId") .IsRequired(true) .HasColumnType("INTEGER") |> ignore - b.Property("MimeType") + b.Property("MimeType") .IsRequired(false) .HasColumnType("TEXT") |> ignore diff --git a/Emulsion.Telegram/LinkGenerator.fs b/Emulsion.Telegram/LinkGenerator.fs index 0f79469b..70c54255 100644 --- a/Emulsion.Telegram/LinkGenerator.fs +++ b/Emulsion.Telegram/LinkGenerator.fs @@ -96,8 +96,8 @@ let private getContentIdentities(message: FunogramMessage): ContentStorage.Messa ChatUserName = chatName MessageId = message.MessageId FileId = fileInfo.FileId - FileName = fileInfo.FileName - MimeType = fileInfo.MimeType + FileName = Option.defaultValue "file.bin" fileInfo.FileName + MimeType = Option.defaultValue "application/octet-stream" fileInfo.MimeType } ) | _ -> Seq.empty diff --git a/Emulsion.Tests/ContentProxy/ContentStorageTests.fs b/Emulsion.Tests/ContentProxy/ContentStorageTests.fs index 86276d16..8c598ec6 100644 --- a/Emulsion.Tests/ContentProxy/ContentStorageTests.fs +++ b/Emulsion.Tests/ContentProxy/ContentStorageTests.fs @@ -10,8 +10,8 @@ let private testIdentity = { ChatUserName = "test" MessageId = 123L FileId = "this_is_file" - FileName = None - MimeType = None + FileName = "file.bin" + MimeType = "application/octet-stream" } let private executeQuery settings = diff --git a/Emulsion.Tests/Database/DatabaseStructureTests.fs b/Emulsion.Tests/Database/DatabaseStructureTests.fs index 50c06362..a2395363 100644 --- a/Emulsion.Tests/Database/DatabaseStructureTests.fs +++ b/Emulsion.Tests/Database/DatabaseStructureTests.fs @@ -16,8 +16,8 @@ let ``Unique constraint should hold``(): unit = ChatUserName = "testChat" MessageId = 666L FileId = "foobar" - FileName = None - MimeType = None + FileName = "file.bin" + MimeType = "application/octet-stream" } async { do! DataStorage.addAsync ctx.TelegramContents newContent diff --git a/Emulsion.Tests/Web/ContentControllerTests.fs b/Emulsion.Tests/Web/ContentControllerTests.fs index 10dae87e..9bec2218 100644 --- a/Emulsion.Tests/Web/ContentControllerTests.fs +++ b/Emulsion.Tests/Web/ContentControllerTests.fs @@ -84,8 +84,8 @@ type ContentControllerTests(output: ITestOutputHelper) = ChatUserName = chatUserName MessageId = messageId FileId = "foobar" - FileName = None - MimeType = None + FileName = "file.bin" + MimeType = "application/octet-stream" } performTestWithContent None content (fun controller -> async { @@ -106,8 +106,8 @@ type ContentControllerTests(output: ITestOutputHelper) = ChatUserName = chatUserName MessageId = messageId FileId = fileId - FileName = None - MimeType = None + FileName = "file.bin" + MimeType = "application/octet-stream" } telegramClient.SetResponse(fileId, None) @@ -131,8 +131,8 @@ type ContentControllerTests(output: ITestOutputHelper) = ChatUserName = chatUserName MessageId = messageId FileId = fileId - FileName = None - MimeType = None + FileName = "file.bin" + MimeType = "application/octet-stream" } use fileCache = setUpFileCache() @@ -160,8 +160,8 @@ type ContentControllerTests(output: ITestOutputHelper) = ChatUserName = chatUserName MessageId = messageId FileId = fileId - FileName = None - MimeType = None + FileName = "file.bin" + MimeType = "application/octet-stream" } let onServerFileId = "fileIdOnServer" diff --git a/Emulsion.Web/ContentController.fs b/Emulsion.Web/ContentController.fs index 062927f9..9dde6043 100644 --- a/Emulsion.Web/ContentController.fs +++ b/Emulsion.Web/ContentController.fs @@ -55,7 +55,5 @@ type ContentController(logger: ILogger, logger.LogWarning $"Link \"{fileInfo}\" could not be downloaded." return this.NotFound() :> IActionResult | Some stream -> - let contentType = Option.defaultValue "application/octet-stream" content.MimeType - let fileName = Option.defaultValue "" content.FileName - return FileStreamResult(stream, contentType, FileDownloadName = fileName) + return FileStreamResult(stream, content.MimeType, FileDownloadName = content.FileName) } From 7936682904ad7f530a5113d15c5e64d4a1c28afa Mon Sep 17 00:00:00 2001 From: Friedrich von Never Date: Sun, 28 Aug 2022 15:55:41 +0200 Subject: [PATCH 23/23] (#102) Settings: update the example --- emulsion.example.json | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/emulsion.example.json b/emulsion.example.json index a7b24ad8..0d064ede 100644 --- a/emulsion.example.json +++ b/emulsion.example.json @@ -25,5 +25,9 @@ "bindUri": "http://*:5000", "hashIdSalt": "test" }, - "fileCache": {} + "fileCache": { + "directory": "./cache", + "fileSizeLimitBytes": 1048576, + "totalCacheSizeLimitBytes": 20971520 + } }