From d05f11b69ffa54bb00a1096c1b6d70a68fbcdee7 Mon Sep 17 00:00:00 2001 From: Szymekc Date: Fri, 24 Nov 2023 18:48:26 +0000 Subject: [PATCH 01/23] add: Dockerfile --- Dockerfile | 17 +++++++++++++++++ compose.yaml | 8 ++++---- 2 files changed, 21 insertions(+), 4 deletions(-) create mode 100644 Dockerfile diff --git a/Dockerfile b/Dockerfile new file mode 100644 index 0000000..fd969f4 --- /dev/null +++ b/Dockerfile @@ -0,0 +1,17 @@ +FROM mcr.microsoft.com/dotnet/sdk:7.0-alpine AS build + +WORKDIR /app + +# Copy source code and compile +COPY ./ ./ +RUN dotnet restore + +RUN dotnet publish -o bin + +# Build runtime image +FROM mcr.microsoft.com/dotnet/aspnet:7.0-alpine AS runtime + +WORKDIR /app +COPY --from=build /app/bin . + +ENTRYPOINT ["dotnet", "SigmaChatServer.App.dll"] diff --git a/compose.yaml b/compose.yaml index 43ed666..e5d165a 100644 --- a/compose.yaml +++ b/compose.yaml @@ -1,8 +1,8 @@ services: - # web: - # build: . - # ports: - # - "8000:5000" + backend: + build: . + ports: + - "80:5000" sqlServer: image: "mcr.microsoft.com/mssql/server" volumes: From e51622a8a879cfbed9666e9004319a996858e968 Mon Sep 17 00:00:00 2001 From: senbar Date: Fri, 24 Nov 2023 20:11:21 +0100 Subject: [PATCH 02/23] Changed provider to postgres; fixed connection string --- Program.fs | 4 ++-- SigmaChatServer.fsproj | 2 +- appsettings.json | 2 +- compose.yaml | 10 +++++----- 4 files changed, 9 insertions(+), 9 deletions(-) diff --git a/Program.fs b/Program.fs index c3c3cb0..96dd705 100644 --- a/Program.fs +++ b/Program.fs @@ -12,7 +12,7 @@ open SigmaChatServer.HttpHandlers open SigmaChatServer.ChatDb open System.Data open Microsoft.Extensions.Configuration -open Microsoft.Data.SqlClient +open Npgsql // --------------------------------- // Web app @@ -64,7 +64,7 @@ let configureServices (services : IServiceCollection) = services.AddTransient( fun serviceProvider -> // The configuration information is in appsettings.json let settings = serviceProvider.GetService() - upcast new SqlConnection(settings.["DbConnectionString"]) ) |> ignore + upcast new NpgsqlConnection(settings.["DbConnectionString"]) ) |> ignore services.AddCors() |> ignore services.AddGiraffe() |> ignore diff --git a/SigmaChatServer.fsproj b/SigmaChatServer.fsproj index 6a686d9..7bb9b2a 100644 --- a/SigmaChatServer.fsproj +++ b/SigmaChatServer.fsproj @@ -8,7 +8,7 @@ - + diff --git a/appsettings.json b/appsettings.json index fc702b4..8f10750 100644 --- a/appsettings.json +++ b/appsettings.json @@ -1,5 +1,5 @@ { - "DbConnectionString": "Server=tcp:localhost,1433;Initial Catalog=SigmaChatDb;Persist Security Info=False;User ID=sa;Password=JHVHjhvh!;MultipleActiveResultSets=False;Encrypt=True;TrustServerCertificate=True;Connection Timeout=30;", + "DbConnectionString": "User ID=sa;Password=JHVHjhvh!;Host=localhost;Port=5432;Database=SigmaChatDb;Pooling=true;Minimum Pool Size=0;Maximum Pool Size=100;Connection Lifetime=0;SSL Mode=Disable;Trust Server Certificate=true", "Logging": { "LogLevel": { "Default": "Information", diff --git a/compose.yaml b/compose.yaml index e5d165a..f26f542 100644 --- a/compose.yaml +++ b/compose.yaml @@ -4,15 +4,15 @@ services: ports: - "80:5000" sqlServer: - image: "mcr.microsoft.com/mssql/server" + image: "postgres" volumes: - sql_data:/var/lib/mysql ports: - - "1433:1433" + - "5432:5432" environment: - NAME: "SigmaChat" - MSSQL_SA_PASSWORD: "JHVHjhvh!" - ACCEPT_EULA: "Y" + - POSTGRES_PASSWORD=JHVHjhvh! + - POSTGRES_USER=sa + - POSTGRES_DB=SigmaChatDb volumes: sql_data: From 4d1831de3067d0dee505302104518218a5d54162 Mon Sep 17 00:00:00 2001 From: Szymekc Date: Fri, 24 Nov 2023 19:38:47 +0000 Subject: [PATCH 03/23] fix: publish appsettings.json --- SigmaChatServer.fsproj | 5 ++++- compose.yaml | 2 +- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/SigmaChatServer.fsproj b/SigmaChatServer.fsproj index 7bb9b2a..1ca8572 100644 --- a/SigmaChatServer.fsproj +++ b/SigmaChatServer.fsproj @@ -19,4 +19,7 @@ - \ No newline at end of file + + + + diff --git a/compose.yaml b/compose.yaml index f26f542..4b1b64c 100644 --- a/compose.yaml +++ b/compose.yaml @@ -2,7 +2,7 @@ services: backend: build: . ports: - - "80:5000" + - "5000:80" sqlServer: image: "postgres" volumes: From 70ed7f23a514fa0c344e6e3118a1b2b12eda0601 Mon Sep 17 00:00:00 2001 From: senbar Date: Wed, 6 Dec 2023 16:50:45 +0100 Subject: [PATCH 04/23] Fixed migrations, added post chat and fixed get chat --- .vscode/launch.json | 30 ++++++++++++++++ .vscode/tasks.json | 12 +++++++ ChatDb.fs | 18 ---------- HttpHandlers.fs | 26 +++++++++++--- Models.fs | 6 +++- Program.fs | 82 +++++++++++++++++++++--------------------- SigmaChatServer.fsproj | 4 ++- sql/ChatDb.fs | 56 +++++++++++++++++++++++++++++ sql/Migrations.fs | 31 ++++++++++++++++ 9 files changed, 200 insertions(+), 65 deletions(-) create mode 100644 .vscode/launch.json create mode 100644 .vscode/tasks.json delete mode 100644 ChatDb.fs create mode 100644 sql/ChatDb.fs create mode 100644 sql/Migrations.fs diff --git a/.vscode/launch.json b/.vscode/launch.json new file mode 100644 index 0000000..395948c --- /dev/null +++ b/.vscode/launch.json @@ -0,0 +1,30 @@ +{ + // Use IntelliSense to learn about possible attributes. + // Hover to view descriptions of existing attributes. + // For more information, visit: https://go.microsoft.com/fwlink/?linkid=830387 + "version": "0.2.0", + "configurations": [ + { + "name": ".NET Core Launch (console)", + "type": "coreclr", + "request": "launch", + "preLaunchTask": "Build: SigmaChatServer.fsproj", + "program": "${workspaceFolder}/bin/Debug/net7.0/SigmaChatServer.App.dll", + "args": [], + "cwd": "${workspaceFolder}", + "stopAtEntry": false, + "console": "internalConsole" + }, + { + "name": "F#: Debug", + "type": "dotnet", + "request": "launch", + "projectPath": "${workspaceFolder}/SigmaChatServer.fsproj" + }, + { + "name": ".NET Core Attach", + "type": "coreclr", + "request": "attach" + } + ] +} diff --git a/.vscode/tasks.json b/.vscode/tasks.json new file mode 100644 index 0000000..c00cbb4 --- /dev/null +++ b/.vscode/tasks.json @@ -0,0 +1,12 @@ +{ + "version": "2.0.0", + "tasks": [ + { + "type": "msbuild", + "problemMatcher": ["$msCompile"], + "group": "build", + "label": "Build: SigmaChatServer.fsproj", + "detail": "Build the SigmaChatServer.fsproj project using dotnet build" + } + ] +} diff --git a/ChatDb.fs b/ChatDb.fs deleted file mode 100644 index 3742cab..0000000 --- a/ChatDb.fs +++ /dev/null @@ -1,18 +0,0 @@ - -namespace SigmaChatServer - -module ChatDb = - - open SigmaChatServer.Models - open Microsoft.AspNetCore.Http - open Giraffe - open System.Data - open Dapper - - let getChat (ctx: HttpContext)= - task { - use connection = ctx.GetService() - let! chat = connection.QueryAsync - "SELECT * FROM Chats" - return chat - } \ No newline at end of file diff --git a/HttpHandlers.fs b/HttpHandlers.fs index 40c86e2..e10e0b8 100644 --- a/HttpHandlers.fs +++ b/HttpHandlers.fs @@ -6,9 +6,25 @@ module HttpHandlers = open Giraffe open SigmaChatServer.Models open SigmaChatServer.ChatDb + open System.Data + open System - let handleGetChat (next : HttpFunc) (ctx : HttpContext) = - task { - let! chat = getChat ctx - return! json chat next ctx - } \ No newline at end of file + let handleGetChats (chatId: int) (next: HttpFunc) (ctx: HttpContext) = + task { + let! chat = getChat ctx chatId + return! json chat next ctx + } + + let handlePostChat (next: HttpFunc) (ctx: HttpContext) = + task { + let! chatId = postChat ctx + return! json chatId next ctx + } + + + let updateSchema (next: HttpFunc) (ctx: HttpContext) = + task { + let connection = ctx.GetService() + let! res = setupDatabaseSchema connection + return! json Ok next ctx + } diff --git a/Models.fs b/Models.fs index a24f3d7..b9645c5 100644 --- a/Models.fs +++ b/Models.fs @@ -9,5 +9,9 @@ type Message ={ [] type Chat = { + ChatId: int Messages: List - } \ No newline at end of file + } + +// [] +// type CreateChat ={} \ No newline at end of file diff --git a/Program.fs b/Program.fs index 96dd705..12c3be4 100644 --- a/Program.fs +++ b/Program.fs @@ -13,26 +13,29 @@ open SigmaChatServer.ChatDb open System.Data open Microsoft.Extensions.Configuration open Npgsql +open Microsoft.AspNetCore.Http +open System.Threading.Tasks // --------------------------------- // Web app // --------------------------------- let webApp = - choose [ - subRoute "/api" - (choose [ - GET >=> choose [ - route "/chat" >=> handleGetChat - ] - ]) - setStatusCode 404 >=> text "Not Found" ] + choose + [ subRoute + "/api" + (choose + [ subRoute + "/chat" + (choose [ GET >=> routef "/%i" (fun id -> handleGetChats id); POST >=> handlePostChat ]) + subRoute "/db" (choose [ GET >=> updateSchema ]) ]) + setStatusCode 404 >=> text "Not Found" ] // --------------------------------- // Error handler // --------------------------------- -let errorHandler (ex : Exception) (logger : ILogger) = +let errorHandler (ex: Exception) (logger: ILogger) = logger.LogError(ex, "An unhandled exception has occurred while executing the request.") clearResponse >=> setStatusCode 500 >=> text ex.Message @@ -40,48 +43,47 @@ let errorHandler (ex : Exception) (logger : ILogger) = // Config and Main // --------------------------------- -let configureCors (builder : CorsPolicyBuilder) = +let configureCors (builder: CorsPolicyBuilder) = builder - .WithOrigins( - "http://localhost:5000", - "https://localhost:5001") - .AllowAnyMethod() - .AllowAnyHeader() - |> ignore + .WithOrigins("http://localhost:5000", "https://localhost:5001") + .AllowAnyMethod() + .AllowAnyHeader() + |> ignore -let configureApp (app : IApplicationBuilder) = +let configureApp (app: IApplicationBuilder) = let env = app.ApplicationServices.GetService() + (match env.IsDevelopment() with - | true -> - app.UseDeveloperExceptionPage() - | false -> - app .UseGiraffeErrorHandler(errorHandler) - .UseHttpsRedirection()) + | true -> app.UseDeveloperExceptionPage() + | false -> app.UseGiraffeErrorHandler(errorHandler).UseHttpsRedirection()) .UseCors(configureCors) .UseGiraffe(webApp) -let configureServices (services : IServiceCollection) = - services.AddTransient( fun serviceProvider -> - // The configuration information is in appsettings.json - let settings = serviceProvider.GetService() - upcast new NpgsqlConnection(settings.["DbConnectionString"]) ) |> ignore - services.AddCors() |> ignore +let configureServices (services: IServiceCollection) = + services.AddTransient(fun serviceProvider -> + // The configuration information is in appsettings.json + let settings = serviceProvider.GetService() + let connection = new NpgsqlConnection(settings.["DbConnectionString"]) + upcast connection) + |> ignore + + services.AddCors() |> ignore services.AddGiraffe() |> ignore -let configureLogging (builder : ILoggingBuilder) = - builder.AddConsole() - .AddDebug() |> ignore +let configureLogging (builder: ILoggingBuilder) = + builder.AddConsole().AddDebug() |> ignore [] let main args = - Host.CreateDefaultBuilder(args) - .ConfigureWebHostDefaults( - fun webHostBuilder -> - webHostBuilder - .Configure(Action configureApp) - .ConfigureServices(configureServices) - .ConfigureLogging(configureLogging) - |> ignore) + Host + .CreateDefaultBuilder(args) + .ConfigureWebHostDefaults(fun webHostBuilder -> + webHostBuilder + .Configure(Action configureApp) + .ConfigureServices(configureServices) + .ConfigureLogging(configureLogging) + |> ignore) .Build() .Run() - 0 \ No newline at end of file + + 0 diff --git a/SigmaChatServer.fsproj b/SigmaChatServer.fsproj index 7bb9b2a..dcdb427 100644 --- a/SigmaChatServer.fsproj +++ b/SigmaChatServer.fsproj @@ -12,11 +12,13 @@ - + + + \ No newline at end of file diff --git a/sql/ChatDb.fs b/sql/ChatDb.fs new file mode 100644 index 0000000..b342dcd --- /dev/null +++ b/sql/ChatDb.fs @@ -0,0 +1,56 @@ +namespace SigmaChatServer + +module ChatDb = + + open SigmaChatServer.Models + open Microsoft.AspNetCore.Http + open Giraffe + open System.Data + open Dapper + open Migrations + open System + + let generateVersionInsert version = + "\n" + + $""" + INSERT INTO "Migrations" ("Version") + VALUES ({version}) + """ + + let generateMigrationScript (migrationsTable: string array) (version: int) = + Array.fold + (fun (accu, vers) next -> (accu + "\n" + next + (generateVersionInsert (vers + 1)), vers + 1)) + ("", version) + migrationsTable[version..] + + let lastMigrationVersion (connection: IDbConnection) = + task { + try + let! version = connection.QueryFirstOrDefaultAsync<{| Version: int |}>(GetVersion) + return version.Version + with _ -> + return 0 + } + + let setupDatabaseSchema (connection: IDbConnection) = + task { + let! version = lastMigrationVersion connection + return! version |> generateMigrationScript Migrations |> connection.QueryAsync + } + + let getChat (ctx: HttpContext) (chatId: int) = + task { + use connection = ctx.GetService() + let sql = """SELECT * FROM "Chats" WHERE "ChatId" = @chatId""" + let data = {| chatId = chatId |} + let! chat = connection.QueryFirstOrDefaultAsync(sql, data) + return chat + } + + let postChat (ctx: HttpContext) = + task { + use connection = ctx.GetService() + let sql = """INSERT INTO "Chats" DEFAULT VALUES RETURNING "ChatId" """ + let! id = connection.ExecuteScalarAsync(sql) + return id + } diff --git a/sql/Migrations.fs b/sql/Migrations.fs new file mode 100644 index 0000000..5404d58 --- /dev/null +++ b/sql/Migrations.fs @@ -0,0 +1,31 @@ +namespace SigmaChatServer + +module Migrations = + let GetVersion= + """ + SELECT "Version" FROM "Migrations" + ORDER BY "Version" DESC + LIMIT 1 + """ + let Migrations=[| + """ + CREATE TABLE "Migrations"( + "Version" INT PRIMARY KEY + ); + """ + """ + CREATE TABLE "Chats"( + "ChatId" serial PRIMARY KEY + ); + + CREATE TABLE "Messages"( + "ChatId" INT NOT NULL, + "MessageId" serial PRIMARY KEY, + "Sender" VARCHAR(100) NOT NULL, + "Text" VARCHAR(500) NOT NULL, + "DateCreated" TIMESTAMP NOT NULL, + FOREIGN KEY ("ChatId") + REFERENCES "Chats" ("ChatId") + ); + """ + |] \ No newline at end of file From e50857ed6431054ffd6f11ccbea08b6947e7b751 Mon Sep 17 00:00:00 2001 From: senbar Date: Sun, 10 Dec 2023 14:21:12 +0100 Subject: [PATCH 05/23] Added Signalr; Added post for messages --- HttpHandlers.fs | 17 +++++++++++++++++ Hub.fs | 16 ++++++++++++++++ Models.fs | 20 +++++++++----------- Program.fs | 33 +++++++++++++++++++-------------- Routing.fs | 22 ++++++++++++++++++++++ SigmaChatServer.fsproj | 5 ++++- sql/ChatDb.fs | 28 ++++++++++++++++++++++++++++ 7 files changed, 115 insertions(+), 26 deletions(-) create mode 100644 Hub.fs create mode 100644 Routing.fs diff --git a/HttpHandlers.fs b/HttpHandlers.fs index e10e0b8..b1d7ad1 100644 --- a/HttpHandlers.fs +++ b/HttpHandlers.fs @@ -8,6 +8,8 @@ module HttpHandlers = open SigmaChatServer.ChatDb open System.Data open System + open Hub + open Microsoft.AspNetCore.SignalR let handleGetChats (chatId: int) (next: HttpFunc) (ctx: HttpContext) = task { @@ -28,3 +30,18 @@ module HttpHandlers = let! res = setupDatabaseSchema connection return! json Ok next ctx } + + let handleGetMessages (chatId: int) (next: HttpFunc) (ctx: HttpContext) = + task { + let! chat = getMessages ctx chatId + return! json chat next ctx + } + + let handlePostMessage (next: HttpFunc) (ctx: HttpContext) = + task { + let hub = ctx.GetService>() + let! createdMessage = postMessage ctx + do! NotifyNewMessageCreated hub createdMessage + + return! json createdMessage next ctx + } diff --git a/Hub.fs b/Hub.fs new file mode 100644 index 0000000..5c49359 --- /dev/null +++ b/Hub.fs @@ -0,0 +1,16 @@ +namespace SigmaChatServer + +module Hub = + open Microsoft.AspNetCore.SignalR + open System + open SigmaChatServer.Models + + type ChatHub() = + inherit Hub() + + override this.OnConnectedAsync() = + Console.WriteLine("connected: " + this.Context.ConnectionId) + base.OnConnectedAsync() + + let NotifyNewMessageCreated (hubContext: IHubContext) (message: Message) = + task { return! hubContext.Clients.All.SendAsync("ReceiveMessage", message) } diff --git a/Models.fs b/Models.fs index b9645c5..92dd605 100644 --- a/Models.fs +++ b/Models.fs @@ -1,17 +1,15 @@ namespace SigmaChatServer.Models +open System + [] -type Message ={ - Sender: string - Text: string -} +type Message = + { MessageId: int + ChatId: int + Sender: string + Text: string + DateCreated: DateTime } [] type Chat = - { - ChatId: int - Messages: List - } - -// [] -// type CreateChat ={} \ No newline at end of file + { ChatId: int; Messages: List } diff --git a/Program.fs b/Program.fs index 12c3be4..e7c4fbb 100644 --- a/Program.fs +++ b/Program.fs @@ -8,28 +8,23 @@ open Microsoft.Extensions.Hosting open Microsoft.Extensions.Logging open Microsoft.Extensions.DependencyInjection open Giraffe -open SigmaChatServer.HttpHandlers -open SigmaChatServer.ChatDb +open SigmaChatServer.Routing open System.Data open Microsoft.Extensions.Configuration open Npgsql open Microsoft.AspNetCore.Http open System.Threading.Tasks - +open Microsoft.AspNet.SignalR +open Microsoft.AspNet.SignalR.Hubs +open Microsoft.AspNetCore.Builder +open Microsoft.Extensions.DependencyInjection +open Microsoft.AspNetCore.Hosting +open Hub // --------------------------------- // Web app // --------------------------------- -let webApp = - choose - [ subRoute - "/api" - (choose - [ subRoute - "/chat" - (choose [ GET >=> routef "/%i" (fun id -> handleGetChats id); POST >=> handlePostChat ]) - subRoute "/db" (choose [ GET >=> updateSchema ]) ]) - setStatusCode 404 >=> text "Not Found" ] +let webApp = routing // --------------------------------- // Error handler @@ -45,7 +40,8 @@ let errorHandler (ex: Exception) (logger: ILogger) = let configureCors (builder: CorsPolicyBuilder) = builder - .WithOrigins("http://localhost:5000", "https://localhost:5001") + // .AllowAnyOrigin() + .WithOrigins("http://localhost:5000", "https://localhost:5001", "http://localhost:3000") .AllowAnyMethod() .AllowAnyHeader() |> ignore @@ -56,7 +52,9 @@ let configureApp (app: IApplicationBuilder) = (match env.IsDevelopment() with | true -> app.UseDeveloperExceptionPage() | false -> app.UseGiraffeErrorHandler(errorHandler).UseHttpsRedirection()) + .UseRouting() .UseCors(configureCors) + .UseEndpoints(fun endpoints -> endpoints.MapHub("/hub") |> ignore) .UseGiraffe(webApp) let configureServices (services: IServiceCollection) = @@ -68,6 +66,13 @@ let configureServices (services: IServiceCollection) = |> ignore services.AddCors() |> ignore + + services.AddSignalR(fun conf -> + conf.EnableDetailedErrors = Nullable true |> ignore + conf.KeepAliveInterval = Nullable(TimeSpan.FromSeconds(5)) |> ignore + conf.HandshakeTimeout = Nullable(TimeSpan.FromSeconds(5)) |> ignore) + |> ignore + services.AddGiraffe() |> ignore let configureLogging (builder: ILoggingBuilder) = diff --git a/Routing.fs b/Routing.fs new file mode 100644 index 0000000..b5e1332 --- /dev/null +++ b/Routing.fs @@ -0,0 +1,22 @@ +namespace SigmaChatServer + +module Routing = + + open Giraffe + open Microsoft.AspNetCore.Http + open HttpHandlers + + let messages: HttpFunc -> HttpContext -> HttpFuncResult = + choose [ GET >=> routef "/%i" handleGetMessages; POST >=> handlePostMessage ] + + let routing: HttpFunc -> HttpContext -> HttpFuncResult = + choose + [ subRoute + "/api" + (choose + [ subRoute + "/chat" + (choose [ GET >=> routef "/%i" (fun id -> handleGetChats id); POST >=> handlePostChat ]) + subRoute "/db" (choose [ GET >=> updateSchema ]) + subRoute "/messages" (messages) ]) + setStatusCode 404 >=> text "Not Found" ] diff --git a/SigmaChatServer.fsproj b/SigmaChatServer.fsproj index 7102df4..c3123c2 100644 --- a/SigmaChatServer.fsproj +++ b/SigmaChatServer.fsproj @@ -8,13 +8,16 @@ + + + @@ -24,4 +27,4 @@ - + \ No newline at end of file diff --git a/sql/ChatDb.fs b/sql/ChatDb.fs index b342dcd..22ddc5e 100644 --- a/sql/ChatDb.fs +++ b/sql/ChatDb.fs @@ -54,3 +54,31 @@ module ChatDb = let! id = connection.ExecuteScalarAsync(sql) return id } + + let postMessage (ctx: HttpContext) = + task { + use connection = ctx.GetService() + let! createMessageModel = ctx.BindJsonAsync() + + let sql = + """INSERT INTO "Messages" ("ChatId", "Sender", "Text", "DateCreated") VALUES (@chatId, @sender, @text, CURRENT_DATE) + RETURNING * """ + + let sqlParams = + {| chatId = createMessageModel.ChatId + sender = createMessageModel.Sender + text = createMessageModel.Text |} + + let! createdMessage = connection.QuerySingleOrDefaultAsync(sql, sqlParams) + return createdMessage + } + + let getMessages (ctx: HttpContext) (chatId: int) = + task { + use connection = ctx.GetService() + + let sql = """SELECT * FROM "Messages" WHERE "ChatId" = @chatId""" + let data = {| chatId = chatId |} + let! messages = connection.QueryAsync(sql, data) + return messages + } From 42a10ec739641e94949df81ef907cdc8a1b65a37 Mon Sep 17 00:00:00 2001 From: senbar Date: Sun, 10 Dec 2023 14:54:05 +0100 Subject: [PATCH 06/23] Fixed migrations missing semicolon; Fixed tuple returned on generating migration script --- sql/ChatDb.fs | 13 ++++++++----- sql/Migrations.fs | 14 +++++++------- 2 files changed, 15 insertions(+), 12 deletions(-) diff --git a/sql/ChatDb.fs b/sql/ChatDb.fs index 22ddc5e..7e1d427 100644 --- a/sql/ChatDb.fs +++ b/sql/ChatDb.fs @@ -14,14 +14,17 @@ module ChatDb = "\n" + $""" INSERT INTO "Migrations" ("Version") - VALUES ({version}) + VALUES ({version}); """ let generateMigrationScript (migrationsTable: string array) (version: int) = - Array.fold - (fun (accu, vers) next -> (accu + "\n" + next + (generateVersionInsert (vers + 1)), vers + 1)) - ("", version) - migrationsTable[version..] + let (sql: string, _: int) = + Array.fold + (fun (accu, vers) next -> (accu + "\r\n " + next + (generateVersionInsert (vers + 1)), vers + 1)) + ("", version) + migrationsTable[version..] + + sql let lastMigrationVersion (connection: IDbConnection) = task { diff --git a/sql/Migrations.fs b/sql/Migrations.fs index 5404d58..9e46a73 100644 --- a/sql/Migrations.fs +++ b/sql/Migrations.fs @@ -1,19 +1,20 @@ namespace SigmaChatServer module Migrations = - let GetVersion= + let GetVersion = """ SELECT "Version" FROM "Migrations" ORDER BY "Version" DESC - LIMIT 1 - """ - let Migrations=[| + LIMIT 1; """ + + let Migrations = + [| """ CREATE TABLE "Migrations"( "Version" INT PRIMARY KEY ); """ - """ + """ CREATE TABLE "Chats"( "ChatId" serial PRIMARY KEY ); @@ -27,5 +28,4 @@ module Migrations = FOREIGN KEY ("ChatId") REFERENCES "Chats" ("ChatId") ); - """ - |] \ No newline at end of file + """ |] From 384f7f78dc213ed2b2c96883b480b7b70706e229 Mon Sep 17 00:00:00 2001 From: senbar Date: Sun, 10 Dec 2023 15:06:12 +0100 Subject: [PATCH 07/23] Added seeding first chat to migrations --- sql/Migrations.fs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/sql/Migrations.fs b/sql/Migrations.fs index 9e46a73..e6c0c39 100644 --- a/sql/Migrations.fs +++ b/sql/Migrations.fs @@ -19,6 +19,8 @@ module Migrations = "ChatId" serial PRIMARY KEY ); + INSERT INTO "Chats" DEFAULT VALUES ; + CREATE TABLE "Messages"( "ChatId" INT NOT NULL, "MessageId" serial PRIMARY KEY, From ea581afda849197e246464fb24dc5986f2df8bd2 Mon Sep 17 00:00:00 2001 From: Szymekc Date: Sun, 10 Dec 2023 21:29:45 +0000 Subject: [PATCH 08/23] add: sigmaChat docker network --- compose.yaml | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/compose.yaml b/compose.yaml index 4b1b64c..05217c8 100644 --- a/compose.yaml +++ b/compose.yaml @@ -3,6 +3,8 @@ services: build: . ports: - "5000:80" + networks: + - sigmaChat sqlServer: image: "postgres" volumes: @@ -13,6 +15,12 @@ services: - POSTGRES_PASSWORD=JHVHjhvh! - POSTGRES_USER=sa - POSTGRES_DB=SigmaChatDb + networks: + - sigmaChat volumes: sql_data: + +networks: + sigmaChat: + name: sigmaChat From 12d9df444a92d1e2d360ca27135af4d6439f9e94 Mon Sep 17 00:00:00 2001 From: senbar Date: Wed, 13 Dec 2023 11:15:05 +0100 Subject: [PATCH 09/23] Added authentication --- HttpHandlers.fs | 7 +++++++ Program.fs | 28 ++++++++++++++++++++++++++++ Routing.fs | 21 +++++++++++++-------- SigmaChatServer.fsproj | 2 ++ 4 files changed, 50 insertions(+), 8 deletions(-) diff --git a/HttpHandlers.fs b/HttpHandlers.fs index b1d7ad1..5e269da 100644 --- a/HttpHandlers.fs +++ b/HttpHandlers.fs @@ -33,6 +33,7 @@ module HttpHandlers = let handleGetMessages (chatId: int) (next: HttpFunc) (ctx: HttpContext) = task { + let z = ctx.User.Claims let! chat = getMessages ctx chatId return! json chat next ctx } @@ -45,3 +46,9 @@ module HttpHandlers = return! json createdMessage next ctx } + + let handleCallback (next: HttpFunc) (ctx: HttpContext) = + task { + let z = ctx.User + return! next ctx + } diff --git a/Program.fs b/Program.fs index e7c4fbb..20c4b40 100644 --- a/Program.fs +++ b/Program.fs @@ -18,8 +18,11 @@ open Microsoft.AspNet.SignalR open Microsoft.AspNet.SignalR.Hubs open Microsoft.AspNetCore.Builder open Microsoft.Extensions.DependencyInjection +open Microsoft.IdentityModel.Tokens open Microsoft.AspNetCore.Hosting +open Microsoft.AspNetCore.Authentication.JwtBearer open Hub +open Microsoft.IdentityModel.Claims // --------------------------------- // Web app // --------------------------------- @@ -54,6 +57,8 @@ let configureApp (app: IApplicationBuilder) = | false -> app.UseGiraffeErrorHandler(errorHandler).UseHttpsRedirection()) .UseRouting() .UseCors(configureCors) + .UseAuthentication() + // .UseAuthorization() .UseEndpoints(fun endpoints -> endpoints.MapHub("/hub") |> ignore) .UseGiraffe(webApp) @@ -73,6 +78,29 @@ let configureServices (services: IServiceCollection) = conf.HandshakeTimeout = Nullable(TimeSpan.FromSeconds(5)) |> ignore) |> ignore + services + .AddAuthentication(JwtBearerDefaults.AuthenticationScheme) + .AddJwtBearer(fun (options) -> + // TODO unhardcode this stuff + let domain = "https://dev-szyhz3rxdab8xgmo.us.auth0.com/" + let audience = "SigmaChatBackend" + + options.Authority <- domain + options.Audience <- audience + + options.TokenValidationParameters <- TokenValidationParameters(NameClaimType = ClaimTypes.NameIdentifier)) + |> ignore + + // services.AddAuthorization() |> ignore + // => options { + // options.AddPolicy( + // "read:admin-messages", + // => policy { policy.Requirements.Add(new RbacRequirement("read:admin-messages")) } + // ) + // } + + + // services.AddSingleton() services.AddGiraffe() |> ignore let configureLogging (builder: ILoggingBuilder) = diff --git a/Routing.fs b/Routing.fs index b5e1332..5e4b281 100644 --- a/Routing.fs +++ b/Routing.fs @@ -6,17 +6,22 @@ module Routing = open Microsoft.AspNetCore.Http open HttpHandlers + let notLoggedIn = RequestErrors.UNAUTHORIZED "Basic" "" "You must be logged in." + + let mustBeLoggedIn: HttpFunc -> HttpContext -> HttpFuncResult = + requiresAuthentication notLoggedIn + let messages: HttpFunc -> HttpContext -> HttpFuncResult = choose [ GET >=> routef "/%i" handleGetMessages; POST >=> handlePostMessage ] let routing: HttpFunc -> HttpContext -> HttpFuncResult = choose - [ subRoute - "/api" - (choose - [ subRoute - "/chat" - (choose [ GET >=> routef "/%i" (fun id -> handleGetChats id); POST >=> handlePostChat ]) - subRoute "/db" (choose [ GET >=> updateSchema ]) - subRoute "/messages" (messages) ]) + [ subRoute "/api" mustBeLoggedIn + >=> (choose + [ subRoute + "/chat" + (choose [ GET >=> routef "/%i" (fun id -> handleGetChats id); POST >=> handlePostChat ]) + subRoute "/db" (choose [ GET >=> updateSchema ]) + subRoute "/messages" (messages) + subRoute "/callback" (handleCallback) ]) setStatusCode 404 >=> text "Not Found" ] diff --git a/SigmaChatServer.fsproj b/SigmaChatServer.fsproj index c3123c2..44d0dd6 100644 --- a/SigmaChatServer.fsproj +++ b/SigmaChatServer.fsproj @@ -9,6 +9,8 @@ + + From 1907e57dbe6dbb6ab50ed78cf7d03f3ee188f0a6 Mon Sep 17 00:00:00 2001 From: senbar Date: Thu, 14 Dec 2023 17:52:47 +0100 Subject: [PATCH 10/23] Remove authentication on db update call --- Routing.fs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/Routing.fs b/Routing.fs index 5e4b281..d06b2e3 100644 --- a/Routing.fs +++ b/Routing.fs @@ -16,12 +16,12 @@ module Routing = let routing: HttpFunc -> HttpContext -> HttpFuncResult = choose - [ subRoute "/api" mustBeLoggedIn - >=> (choose - [ subRoute - "/chat" - (choose [ GET >=> routef "/%i" (fun id -> handleGetChats id); POST >=> handlePostChat ]) - subRoute "/db" (choose [ GET >=> updateSchema ]) - subRoute "/messages" (messages) - subRoute "/callback" (handleCallback) ]) + [ subRoute + "/api" + (choose + [ subRoute "/chat" mustBeLoggedIn + >=> (choose [ GET >=> routef "/%i" (fun id -> handleGetChats id); POST >=> handlePostChat ]) + subRoute "/db" (choose [ GET >=> updateSchema ]) + subRoute "/messages" mustBeLoggedIn >=> (messages) + subRoute "/callback" mustBeLoggedIn >=> (handleCallback) ]) setStatusCode 404 >=> text "Not Found" ] From d6c6077e5e68c64c1fdb84e1b3fa75ce7247ecbc Mon Sep 17 00:00:00 2001 From: senbar Date: Fri, 15 Dec 2023 00:19:46 +0100 Subject: [PATCH 11/23] CORS for docker --- Program.fs | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/Program.fs b/Program.fs index 20c4b40..ab504b9 100644 --- a/Program.fs +++ b/Program.fs @@ -44,7 +44,14 @@ let errorHandler (ex: Exception) (logger: ILogger) = let configureCors (builder: CorsPolicyBuilder) = builder // .AllowAnyOrigin() - .WithOrigins("http://localhost:5000", "https://localhost:5001", "http://localhost:3000") + .WithOrigins( + "http://localhost:5000", + "https://localhost:5001", + "http://localhost:3000", + "https://sigmachat.cc", + "http://frontend:3000", + "http://frontend" + ) .AllowAnyMethod() .AllowAnyHeader() |> ignore From 387e20a01d31e68bf9db7afc9dbb718cbc711f4a Mon Sep 17 00:00:00 2001 From: senbar Date: Fri, 22 Dec 2023 18:05:10 +0100 Subject: [PATCH 12/23] User entites added; Reference from messages to users added, now mapping username through Users; --- HttpHandlers.fs | 55 ++++++++++++++++++++++++++++++++++----- Hub.fs | 2 +- Models.fs | 18 ++++++++++--- Routing.fs | 3 +++ SigmaChatServer.fsproj | 1 + sql/ChatDb.fs | 22 ++++++++++------ sql/Migrations.fs | 13 +++++++++- sql/UserDb.fs | 58 ++++++++++++++++++++++++++++++++++++++++++ 8 files changed, 153 insertions(+), 19 deletions(-) create mode 100644 sql/UserDb.fs diff --git a/HttpHandlers.fs b/HttpHandlers.fs index 5e269da..586ac64 100644 --- a/HttpHandlers.fs +++ b/HttpHandlers.fs @@ -10,6 +10,8 @@ module HttpHandlers = open System open Hub open Microsoft.AspNetCore.SignalR + open UserDb + open System.Threading.Tasks let handleGetChats (chatId: int) (next: HttpFunc) (ctx: HttpContext) = task { @@ -33,7 +35,6 @@ module HttpHandlers = let handleGetMessages (chatId: int) (next: HttpFunc) (ctx: HttpContext) = task { - let z = ctx.User.Claims let! chat = getMessages ctx chatId return! json chat next ctx } @@ -41,14 +42,56 @@ module HttpHandlers = let handlePostMessage (next: HttpFunc) (ctx: HttpContext) = task { let hub = ctx.GetService>() - let! createdMessage = postMessage ctx - do! NotifyNewMessageCreated hub createdMessage + let! createMessageModel = ctx.BindJsonAsync() + let userId = ctx.User.Identity.Name - return! json createdMessage next ctx + let processTooShortMessage () = + task { return! RequestErrors.BAD_REQUEST (text "Basic") next ctx } + + let processCorrectMessage model = + task { + let! createdMessage = postMessage ctx model userId + do! notifyNewMessageCreated hub createdMessage + return! json createdMessage next ctx + } + + return! + match createMessageModel with + | model when model.Text.Length = 0 -> processTooShortMessage () + | model -> processCorrectMessage model } let handleCallback (next: HttpFunc) (ctx: HttpContext) = task { - let z = ctx.User - return! next ctx + let userId = ctx.User.Identity.Name + let! userInDb = getUser ctx userId + + let! resultingUser = + match userInDb with + | Some user -> Task.FromResult(user) + | None -> createUser ctx userId + + return! json resultingUser next ctx + } + + let handleUpdateMeProfile (next: HttpFunc) (ctx: HttpContext) = + task { + let userId = ctx.User.Identity.Name + let! updateMeModel = ctx.BindJsonAsync() + do! updateUser ctx userId updateMeModel + + return! json None next ctx + } + + let handleGetUserMe (next: HttpFunc) (ctx: HttpContext) = + task { + let userId = ctx.User.Identity.Name + let! user = getUser ctx userId + + let res = + match user with + | Some u -> json u next ctx + | None -> RequestErrors.UNAUTHORIZED "Basic" "" "You must be logged in." next ctx + + return! res } diff --git a/Hub.fs b/Hub.fs index 5c49359..517fab2 100644 --- a/Hub.fs +++ b/Hub.fs @@ -12,5 +12,5 @@ module Hub = Console.WriteLine("connected: " + this.Context.ConnectionId) base.OnConnectedAsync() - let NotifyNewMessageCreated (hubContext: IHubContext) (message: Message) = + let notifyNewMessageCreated (hubContext: IHubContext) (message: MessageModel) = task { return! hubContext.Clients.All.SendAsync("ReceiveMessage", message) } diff --git a/Models.fs b/Models.fs index 92dd605..ea15e57 100644 --- a/Models.fs +++ b/Models.fs @@ -3,13 +3,25 @@ namespace SigmaChatServer.Models open System [] -type Message = +type MessageModel = { MessageId: int ChatId: int - Sender: string + UserNickname: string Text: string DateCreated: DateTime } +type CreateMessageModel = { ChatId: int; Text: string } + [] type Chat = - { ChatId: int; Messages: List } + { ChatId: int + Messages: List } + +[] +type User = + { Id: string + Email: string + Nickname: string } + +[] +type UpdateMeModel = { Nickname: string } diff --git a/Routing.fs b/Routing.fs index d06b2e3..7b8d67b 100644 --- a/Routing.fs +++ b/Routing.fs @@ -23,5 +23,8 @@ module Routing = >=> (choose [ GET >=> routef "/%i" (fun id -> handleGetChats id); POST >=> handlePostChat ]) subRoute "/db" (choose [ GET >=> updateSchema ]) subRoute "/messages" mustBeLoggedIn >=> (messages) + subRoute "/user/me" mustBeLoggedIn + >=> (choose[GET >=> handleGetUserMe + PATCH >=> handleUpdateMeProfile]) subRoute "/callback" mustBeLoggedIn >=> (handleCallback) ]) setStatusCode 404 >=> text "Not Found" ] diff --git a/SigmaChatServer.fsproj b/SigmaChatServer.fsproj index 44d0dd6..2bf764b 100644 --- a/SigmaChatServer.fsproj +++ b/SigmaChatServer.fsproj @@ -17,6 +17,7 @@ + diff --git a/sql/ChatDb.fs b/sql/ChatDb.fs index 7e1d427..223d5c5 100644 --- a/sql/ChatDb.fs +++ b/sql/ChatDb.fs @@ -58,21 +58,23 @@ module ChatDb = return id } - let postMessage (ctx: HttpContext) = + let postMessage (ctx: HttpContext) (createMessageModel: CreateMessageModel) (userId: string) = task { use connection = ctx.GetService() - let! createMessageModel = ctx.BindJsonAsync() let sql = - """INSERT INTO "Messages" ("ChatId", "Sender", "Text", "DateCreated") VALUES (@chatId, @sender, @text, CURRENT_DATE) - RETURNING * """ + """ + WITH new_message AS (INSERT INTO "Messages" ("ChatId", "UserId", "Text", "DateCreated") VALUES (@chatId, @userId, @text, CURRENT_DATE) RETURNING *), + message_model as (SELECT new_message.*, "Users"."Nickname" AS "UserNickname" FROM new_message LEFT JOIN "Users" ON new_message."UserId" = "Users"."Id" ) + SELECT message_model.* from message_model;""" let sqlParams = {| chatId = createMessageModel.ChatId - sender = createMessageModel.Sender + userId = userId text = createMessageModel.Text |} - let! createdMessage = connection.QuerySingleOrDefaultAsync(sql, sqlParams) + let! createdMessage = connection.QuerySingleOrDefaultAsync(sql, sqlParams) + return createdMessage } @@ -80,8 +82,12 @@ module ChatDb = task { use connection = ctx.GetService() - let sql = """SELECT * FROM "Messages" WHERE "ChatId" = @chatId""" + let sql = + """SELECT "Messages".*, "Users"."Nickname" as "UserNickname" FROM "Messages" + LEFT JOIN "Users" on "Messages"."UserId"="Users"."Id" + WHERE "ChatId"= @chatId""" + let data = {| chatId = chatId |} - let! messages = connection.QueryAsync(sql, data) + let! messages = connection.QueryAsync(sql, data) return messages } diff --git a/sql/Migrations.fs b/sql/Migrations.fs index e6c0c39..d6a267a 100644 --- a/sql/Migrations.fs +++ b/sql/Migrations.fs @@ -30,4 +30,15 @@ module Migrations = FOREIGN KEY ("ChatId") REFERENCES "Chats" ("ChatId") ); - """ |] + """ + """ + CREATE TABLE "Users"( + "Id" VARCHAR(50) PRIMARY KEY, + "Email" VARCHAR(500), + "Nickname" VARCHAR(500) + ); + + ALTER TABLE "Messages" + DROP COLUMN "Sender", + ADD COLUMN "UserId" VARCHAR(50) NOT NULL REFERENCES "Users"("Id"); + """ |] diff --git a/sql/UserDb.fs b/sql/UserDb.fs new file mode 100644 index 0000000..5ca4183 --- /dev/null +++ b/sql/UserDb.fs @@ -0,0 +1,58 @@ +namespace SigmaChatServer + +module UserDb = + open Microsoft.AspNetCore.Http + open Giraffe + open System.Data + open Dapper + open SigmaChatServer.Models + open System + open Microsoft.FSharp.Core + + let createUser (ctx: HttpContext) (userId: string) = + task { + use connection = ctx.GetService() + + let sql = + """INSERT INTO "Users" ("Id") + VALUES (@userId) RETURNING *;""" + + let sqlParams = {| userId = userId |} + + let! user = connection.QueryFirstAsync(sql, sqlParams) + return (user) + } + + let updateUser (ctx: HttpContext) (userId: string) (model: UpdateMeModel) = + task { + use connection = ctx.GetService() + + let sql = + """UPDATE "Users" SET "Nickname" = @nickname + WHERE "Id" = @userId; """ + + let sqlParams = + {| userId = userId + nickname = model.Nickname |} + + let! _ = connection.ExecuteAsync(sql, sqlParams) + return () + } + + let getUser (ctx: HttpContext) (userId: string) = + task { + use connection = ctx.GetService() + + let sql = """SELECT * FROM "Users" WHERE "Id" = @userId;""" + + let sqlParams = {| userId = userId |} + + let! user = connection.QueryFirstOrDefaultAsync(sql, sqlParams) + + let optioned = + match box user with + | null -> None + | _ -> Some user + + return optioned + } From ed3564d99281ac2ddf20763481b85d3a75bccf2e Mon Sep 17 00:00:00 2001 From: senbar Date: Sat, 30 Dec 2023 17:31:13 +0100 Subject: [PATCH 13/23] Message order fix; Fixed timestamp being only date --- sql/ChatDb.fs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/sql/ChatDb.fs b/sql/ChatDb.fs index 223d5c5..5d06dea 100644 --- a/sql/ChatDb.fs +++ b/sql/ChatDb.fs @@ -64,7 +64,7 @@ module ChatDb = let sql = """ - WITH new_message AS (INSERT INTO "Messages" ("ChatId", "UserId", "Text", "DateCreated") VALUES (@chatId, @userId, @text, CURRENT_DATE) RETURNING *), + WITH new_message AS (INSERT INTO "Messages" ("ChatId", "UserId", "Text", "DateCreated") VALUES (@chatId, @userId, @text, NOW()) RETURNING *), message_model as (SELECT new_message.*, "Users"."Nickname" AS "UserNickname" FROM new_message LEFT JOIN "Users" ON new_message."UserId" = "Users"."Id" ) SELECT message_model.* from message_model;""" @@ -85,7 +85,8 @@ module ChatDb = let sql = """SELECT "Messages".*, "Users"."Nickname" as "UserNickname" FROM "Messages" LEFT JOIN "Users" on "Messages"."UserId"="Users"."Id" - WHERE "ChatId"= @chatId""" + WHERE "ChatId"= @chatId + ORDER BY "MessageId";""" let data = {| chatId = chatId |} let! messages = connection.QueryAsync(sql, data) From 93c213feedddefb061fa40c384bab625387f334b Mon Sep 17 00:00:00 2001 From: senbar Date: Fri, 2 Feb 2024 00:08:27 +0100 Subject: [PATCH 14/23] Three things: Changed handling of returning no result queries from returning some wild null values unsupported by F# to try catching not OrDefault query and returning Option. Added webpush implemented with C# webpush lib. Its super annoying rn though, theres no limitng on notifications so it will spam users even on their own messages. Added table for storing subscription instances which probably can use some work- maybe put it for each user no reason to hold old ones. Added commented out admin endpoint for testing webpush sending message to everyone. Added ignore rule to gitignore for appsettings for specific env. --- .gitignore | 3 ++ HttpHandlers.fs | 14 ++++-- Models.fs | 3 ++ Routing.fs | 9 ++-- SigmaChatServer.fsproj | 3 ++ WebPush.fs | 103 +++++++++++++++++++++++++++++++++++++++++ appsettings.json | 5 ++ sql/ChatDb.fs | 12 +++-- sql/Migrations.fs | 16 +++++-- sql/WebPushDb.fs | 56 ++++++++++++++++++++++ 10 files changed, 211 insertions(+), 13 deletions(-) create mode 100644 WebPush.fs create mode 100644 sql/WebPushDb.fs diff --git a/.gitignore b/.gitignore index cdb73de..933078f 100644 --- a/.gitignore +++ b/.gitignore @@ -253,3 +253,6 @@ paket-files/ # JetBrains Rider .idea/ *.sln.iml + + +appsettings.*.json diff --git a/HttpHandlers.fs b/HttpHandlers.fs index 586ac64..3432ee4 100644 --- a/HttpHandlers.fs +++ b/HttpHandlers.fs @@ -8,6 +8,7 @@ module HttpHandlers = open SigmaChatServer.ChatDb open System.Data open System + open SigmaChatServer.WebPush open Hub open Microsoft.AspNetCore.SignalR open UserDb @@ -16,7 +17,11 @@ module HttpHandlers = let handleGetChats (chatId: int) (next: HttpFunc) (ctx: HttpContext) = task { let! chat = getChat ctx chatId - return! json chat next ctx + + return! + match chat with + | Some chat -> json chat next ctx + | None -> json (RequestErrors.NOT_FOUND(text "Basic")) next ctx } let handlePostChat (next: HttpFunc) (ctx: HttpContext) = @@ -42,7 +47,6 @@ module HttpHandlers = let handlePostMessage (next: HttpFunc) (ctx: HttpContext) = task { let hub = ctx.GetService>() - let! createMessageModel = ctx.BindJsonAsync() let userId = ctx.User.Identity.Name let processTooShortMessage () = @@ -50,11 +54,15 @@ module HttpHandlers = let processCorrectMessage model = task { - let! createdMessage = postMessage ctx model userId + let! createdMessage = insertMessage ctx model userId do! notifyNewMessageCreated hub createdMessage + do! webpushMessageForUser ctx userId model + return! json createdMessage next ctx } + let! createMessageModel = ctx.BindJsonAsync() + return! match createMessageModel with | model when model.Text.Length = 0 -> processTooShortMessage () diff --git a/Models.fs b/Models.fs index ea15e57..8051a5a 100644 --- a/Models.fs +++ b/Models.fs @@ -12,6 +12,9 @@ type MessageModel = type CreateMessageModel = { ChatId: int; Text: string } +[] +type WebPushSubscriptionModel = { ChatId: int; Json: string } + [] type Chat = { ChatId: int diff --git a/Routing.fs b/Routing.fs index 7b8d67b..fc9c26b 100644 --- a/Routing.fs +++ b/Routing.fs @@ -5,6 +5,7 @@ module Routing = open Giraffe open Microsoft.AspNetCore.Http open HttpHandlers + open WebPush let notLoggedIn = RequestErrors.UNAUTHORIZED "Basic" "" "You must be logged in." @@ -24,7 +25,9 @@ module Routing = subRoute "/db" (choose [ GET >=> updateSchema ]) subRoute "/messages" mustBeLoggedIn >=> (messages) subRoute "/user/me" mustBeLoggedIn - >=> (choose[GET >=> handleGetUserMe - PATCH >=> handleUpdateMeProfile]) - subRoute "/callback" mustBeLoggedIn >=> (handleCallback) ]) + >=> (choose [ GET >=> handleGetUserMe; PATCH >=> handleUpdateMeProfile ]) + subRoute "/callback" mustBeLoggedIn >=> (handleCallback) + subRoute "/web-push/subscribe" mustBeLoggedIn >=> (handleNewSubscription) + subRoute "/web-push/key" mustBeLoggedIn >=> (handleGetVapidKey) ]) + // subRoute "/web-push/custom-message" mustBeLoggedIn >=> (handlePushCustomMessage) ]) setStatusCode 404 >=> text "Not Found" ] diff --git a/SigmaChatServer.fsproj b/SigmaChatServer.fsproj index 2bf764b..df08646 100644 --- a/SigmaChatServer.fsproj +++ b/SigmaChatServer.fsproj @@ -12,13 +12,16 @@ + + + diff --git a/WebPush.fs b/WebPush.fs new file mode 100644 index 0000000..a906453 --- /dev/null +++ b/WebPush.fs @@ -0,0 +1,103 @@ +namespace SigmaChatServer + +module WebPush = + open WebPush + open Microsoft.AspNetCore.Http + open Giraffe + open ChatDb + open WebPushDb + open Microsoft.Extensions.Configuration + open SigmaChatServer.Models + open System.Text.Json.Nodes + open Newtonsoft.Json.Linq + open System.Threading.Tasks + open System.Collections.Generic + open System.Text.Json + + let private getVapidDetails (configuration: IConfiguration) = + let vapidSection = configuration.GetSection("Vapid") + let vapidPublic = vapidSection.["Public"] + let vapidPrivate = vapidSection.["Private"] + let vapidSubject = vapidSection.["Subject"] + + new VapidDetails(vapidSubject, vapidPublic, vapidPrivate) + + let private pushPayload (subscription: PushSubscription) (vapidDetails: VapidDetails) (payload: string) = + task { + let webPushClient = new WebPushClient() + return! webPushClient.SendNotificationAsync(subscription, payload, vapidDetails) + } + + let private parseSubscription (json: string) = + let j = JObject.Parse json + + new PushSubscription( + j.SelectToken "endpoint" |> string, + j.SelectToken "keys.p256dh" |> string, + j.SelectToken "keys.auth" |> string + ) + + let webpushMessageForUser (ctx: HttpContext) (userId: string) (createdMessageModel: CreateMessageModel) = + task { + let! subscriptionEntity = getSubscription ctx userId + let configuration = ctx.GetService() + + let payload = + JsonSerializer.Serialize + {| title = createdMessageModel.Text + // probable svg wont work todo test this + icon = "https://sigmachat.cc/cc.svg" |} + + return! + match subscriptionEntity with + // todo add logging + | None -> task { return () } + | Some sub -> + let parsedSubscription = parseSubscription sub.Json + let vapidDetails = getVapidDetails configuration + pushPayload parsedSubscription vapidDetails payload + } + + let handleNewSubscription (next: HttpFunc) (ctx: HttpContext) = + task { + let userId = ctx.User.Identity.Name + let! subJson = ctx.ReadBodyFromRequestAsync() + + do! insertSubscription ctx subJson userId + + return! json None next ctx + } + + let handleGetVapidKey (next: HttpFunc) (ctx: HttpContext) = + let configuration = ctx.GetService() + + let vapidSection = configuration.GetSection("Vapid") + let vapidPublic = vapidSection.["Public"] + + task { return! json {| PublicKey = vapidPublic |} next ctx } + + let handlePushCustomMessage (next: HttpFunc) (ctx: HttpContext) = + task { + let! message = ctx.ReadBodyFromRequestAsync() + let configuration = ctx.GetService() + + let! parsedSubscriptions = getAllSubscriptions ctx + let vapidDetails = getVapidDetails configuration + + let subs = + parsedSubscriptions |> List.ofSeq |> Seq.map (fun a -> parseSubscription a.Json) + + + let payload = + JsonSerializer.Serialize + {| title = message + options = {| body = message |} |} + + let! z = + Task.WhenAll( + subs + |> Seq.map (fun subscription -> pushPayload subscription vapidDetails payload) + ) + + return! json None next ctx + } diff --git a/appsettings.json b/appsettings.json index 8f10750..207afcb 100644 --- a/appsettings.json +++ b/appsettings.json @@ -1,5 +1,10 @@ { "DbConnectionString": "User ID=sa;Password=JHVHjhvh!;Host=localhost;Port=5432;Database=SigmaChatDb;Pooling=true;Minimum Pool Size=0;Maximum Pool Size=100;Connection Lifetime=0;SSL Mode=Disable;Trust Server Certificate=true", + "Vapid":{ + "Subject":"", + "Private":"", + "Public":"" + }, "Logging": { "LogLevel": { "Default": "Information", diff --git a/sql/ChatDb.fs b/sql/ChatDb.fs index 5d06dea..1929c6e 100644 --- a/sql/ChatDb.fs +++ b/sql/ChatDb.fs @@ -29,7 +29,7 @@ module ChatDb = let lastMigrationVersion (connection: IDbConnection) = task { try - let! version = connection.QueryFirstOrDefaultAsync<{| Version: int |}>(GetVersion) + let! version = connection.QueryFirstAsync<{| Version: int |}>(GetVersion) return version.Version with _ -> return 0 @@ -46,8 +46,12 @@ module ChatDb = use connection = ctx.GetService() let sql = """SELECT * FROM "Chats" WHERE "ChatId" = @chatId""" let data = {| chatId = chatId |} - let! chat = connection.QueryFirstOrDefaultAsync(sql, data) - return chat + + try + let! chat = connection.QueryFirstAsync(sql, data) + return Some chat + with :? InvalidOperationException -> + return None } let postChat (ctx: HttpContext) = @@ -58,7 +62,7 @@ module ChatDb = return id } - let postMessage (ctx: HttpContext) (createMessageModel: CreateMessageModel) (userId: string) = + let insertMessage (ctx: HttpContext) (createMessageModel: CreateMessageModel) (userId: string) = task { use connection = ctx.GetService() diff --git a/sql/Migrations.fs b/sql/Migrations.fs index d6a267a..0cb1ffb 100644 --- a/sql/Migrations.fs +++ b/sql/Migrations.fs @@ -13,7 +13,7 @@ module Migrations = CREATE TABLE "Migrations"( "Version" INT PRIMARY KEY ); - """ + """ """ CREATE TABLE "Chats"( "ChatId" serial PRIMARY KEY @@ -30,7 +30,7 @@ module Migrations = FOREIGN KEY ("ChatId") REFERENCES "Chats" ("ChatId") ); - """ + """ """ CREATE TABLE "Users"( "Id" VARCHAR(50) PRIMARY KEY, @@ -41,4 +41,14 @@ module Migrations = ALTER TABLE "Messages" DROP COLUMN "Sender", ADD COLUMN "UserId" VARCHAR(50) NOT NULL REFERENCES "Users"("Id"); - """ |] + """ + """ + CREATE TABLE "PushSubscriptions"( + "Id" serial PRIMARY KEY, + "UserId" VARCHAR(50), + "Json" VARCHAR(4000), + "DateCreated" TIMESTAMP NOT NULL, + FOREIGN KEY ("UserId") + REFERENCES "Users" ("Id") + ); + """ |] diff --git a/sql/WebPushDb.fs b/sql/WebPushDb.fs new file mode 100644 index 0000000..87cebfe --- /dev/null +++ b/sql/WebPushDb.fs @@ -0,0 +1,56 @@ +namespace SigmaChatServer + +module WebPushDb = + open Microsoft.AspNetCore.Http + open Giraffe + open System.Data + open Dapper + open SigmaChatServer.Models + open System + open Microsoft.FSharp.Core + + let insertSubscription (ctx: HttpContext) (json: string) (userId: string) = + task { + use connection = ctx.GetService() + + let sql = + """ + INSERT INTO "PushSubscriptions" ( "UserId", "Json", "DateCreated") VALUES ( @userId, @json, NOW()); + """ + + let sqlParams = {| userId = userId; json = json |} + + let! _ = connection.ExecuteScalarAsync(sql, sqlParams) + + return () + } + + let getSubscription (ctx: HttpContext) (userId: string) = + task { + use connection = ctx.GetService() + + //WHERE "UserId"= @userId + let sql = + """SELECT * FROM "PushSubscriptions" + ORDER BY "DateCreated" DESC + LIMIT 1;""" + + let data = {| userId = userId |} + + try + let! subscription = connection.QueryFirstAsync(sql, data) + return Some subscription + with :? InvalidOperationException -> + return None + } + + let getAllSubscriptions (ctx: HttpContext) = + task { + use connection = ctx.GetService() + + let sql = + """SELECT * FROM "PushSubscriptions";""" + + let! subscriptions = connection.QueryAsync(sql) + return subscriptions + } From bca7f3827404129a09e6e0826f5d2258e3187a32 Mon Sep 17 00:00:00 2001 From: senbar Date: Fri, 2 Feb 2024 18:52:23 +0100 Subject: [PATCH 15/23] Fix for notifying all subscribers. Now all users of sigma chat will be notified, before it selected only the most recent subscription since I have setup it this way for debugging. In the future it should only notify users who are participating in chat and should have throttling so that it doesn't spam. --- HttpHandlers.fs | 3 ++- WebPush.fs | 21 ++++++++++----------- sql/Migrations.fs | 11 +++++++++++ sql/UserDb.fs | 11 +++++++++++ sql/WebPushDb.fs | 38 +++++++++++++++++++++----------------- 5 files changed, 55 insertions(+), 29 deletions(-) diff --git a/HttpHandlers.fs b/HttpHandlers.fs index 3432ee4..09d4009 100644 --- a/HttpHandlers.fs +++ b/HttpHandlers.fs @@ -55,8 +55,9 @@ module HttpHandlers = let processCorrectMessage model = task { let! createdMessage = insertMessage ctx model userId + let! allUserids = getAllUserIds ctx do! notifyNewMessageCreated hub createdMessage - do! webpushMessageForUser ctx userId model + let! _ = webpushMessageForUser ctx allUserids model return! json createdMessage next ctx } diff --git a/WebPush.fs b/WebPush.fs index a906453..da92275 100644 --- a/WebPush.fs +++ b/WebPush.fs @@ -37,9 +37,9 @@ module WebPush = j.SelectToken "keys.auth" |> string ) - let webpushMessageForUser (ctx: HttpContext) (userId: string) (createdMessageModel: CreateMessageModel) = + let webpushMessageForUser (ctx: HttpContext) (userIds: string seq) (createdMessageModel: CreateMessageModel) = task { - let! subscriptionEntity = getSubscription ctx userId + let! subscriptionEntities = getSubscriptions ctx userIds let configuration = ctx.GetService() let payload = @@ -48,14 +48,13 @@ module WebPush = // probable svg wont work todo test this icon = "https://sigmachat.cc/cc.svg" |} + let vapidDetails = getVapidDetails configuration + return! - match subscriptionEntity with - // todo add logging - | None -> task { return () } - | Some sub -> - let parsedSubscription = parseSubscription sub.Json - let vapidDetails = getVapidDetails configuration - pushPayload parsedSubscription vapidDetails payload + subscriptionEntities + |> Seq.map (fun a -> parseSubscription a.Json) + |> Seq.map (fun a -> pushPayload a vapidDetails payload) + |> Task.WhenAll } let handleNewSubscription (next: HttpFunc) (ctx: HttpContext) = @@ -63,7 +62,7 @@ module WebPush = let userId = ctx.User.Identity.Name let! subJson = ctx.ReadBodyFromRequestAsync() - do! insertSubscription ctx subJson userId + do! upsertSubscription ctx subJson userId return! json None next ctx } @@ -93,7 +92,7 @@ module WebPush = {| title = message options = {| body = message |} |} - let! z = + let! _ = Task.WhenAll( subs |> Seq.map (fun subscription -> pushPayload subscription vapidDetails payload) diff --git a/sql/Migrations.fs b/sql/Migrations.fs index 0cb1ffb..a3738fe 100644 --- a/sql/Migrations.fs +++ b/sql/Migrations.fs @@ -51,4 +51,15 @@ module Migrations = FOREIGN KEY ("UserId") REFERENCES "Users" ("Id") ); + """ + """ + DROP TABLE "PushSubscriptions"; + + CREATE TABLE "PushSubscriptions"( + "UserId" VARCHAR(50) PRIMARY KEY, + "Json" VARCHAR(4000), + "DateCreated" TIMESTAMP NOT NULL, + FOREIGN KEY ("UserId") + REFERENCES "Users" ("Id") + ); """ |] diff --git a/sql/UserDb.fs b/sql/UserDb.fs index 5ca4183..ddf8be0 100644 --- a/sql/UserDb.fs +++ b/sql/UserDb.fs @@ -56,3 +56,14 @@ module UserDb = return optioned } + + let getAllUserIds (ctx: HttpContext) = + task { + use connection = ctx.GetService() + + let sql = """SELECT "Id" FROM "Users";""" + + let! userIds = connection.QueryAsync(sql) + return userIds + } + diff --git a/sql/WebPushDb.fs b/sql/WebPushDb.fs index 87cebfe..0c8a9f1 100644 --- a/sql/WebPushDb.fs +++ b/sql/WebPushDb.fs @@ -9,13 +9,16 @@ module WebPushDb = open System open Microsoft.FSharp.Core - let insertSubscription (ctx: HttpContext) (json: string) (userId: string) = + let upsertSubscription (ctx: HttpContext) (json: string) (userId: string) = task { use connection = ctx.GetService() let sql = """ - INSERT INTO "PushSubscriptions" ( "UserId", "Json", "DateCreated") VALUES ( @userId, @json, NOW()); + INSERT INTO "PushSubscriptions" ( "UserId", "Json", "DateCreated") VALUES ( @userId, @json, NOW()) + ON CONFLICT ("UserId") DO UPDATE + SET "Json" = EXCLUDED."Json", + "DateCreated" = EXCLUDED."DateCreated";; """ let sqlParams = {| userId = userId; json = json |} @@ -25,31 +28,32 @@ module WebPushDb = return () } - let getSubscription (ctx: HttpContext) (userId: string) = + let getSubscriptions (ctx: HttpContext) (userId: string seq) = task { use connection = ctx.GetService() - //WHERE "UserId"= @userId let sql = - """SELECT * FROM "PushSubscriptions" - ORDER BY "DateCreated" DESC - LIMIT 1;""" - - let data = {| userId = userId |} - - try - let! subscription = connection.QueryFirstAsync(sql, data) - return Some subscription - with :? InvalidOperationException -> - return None + """WITH LatestSubscriptions AS ( + SELECT "UserId", MAX("DateCreated") AS MaxDate + FROM "PushSubscriptions" + WHERE "UserId" = ANY(@userIds) + GROUP BY "UserId" + ) + SELECT PS.* + FROM "PushSubscriptions" PS + INNER JOIN LatestSubscriptions LS ON PS."UserId" = LS."UserId" AND PS."DateCreated" = LS.MaxDate;""" + + let data = {| userIds = userId |} + + let! subscription = connection.QueryAsync(sql, data) + return subscription } let getAllSubscriptions (ctx: HttpContext) = task { use connection = ctx.GetService() - let sql = - """SELECT * FROM "PushSubscriptions";""" + let sql = """SELECT * FROM "PushSubscriptions";""" let! subscriptions = connection.QueryAsync(sql) return subscriptions From 40ec7b1aa944a7bd1b0e49a189da81c1bbfa544f Mon Sep 17 00:00:00 2001 From: senbar Date: Fri, 2 Feb 2024 20:44:09 +0100 Subject: [PATCH 16/23] Error was thrown when subscription was expired, made it just skip this sub. --- WebPush.fs | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/WebPush.fs b/WebPush.fs index da92275..095f9c8 100644 --- a/WebPush.fs +++ b/WebPush.fs @@ -53,7 +53,11 @@ module WebPush = return! subscriptionEntities |> Seq.map (fun a -> parseSubscription a.Json) - |> Seq.map (fun a -> pushPayload a vapidDetails payload) + |> Seq.map (fun a -> + try + pushPayload a vapidDetails payload + with _ -> + task { return () }) |> Task.WhenAll } From c27e669946055a4db490ff23e0dc9afd0d6d9534 Mon Sep 17 00:00:00 2001 From: senbar Date: Thu, 15 Feb 2024 13:47:59 +0100 Subject: [PATCH 17/23] Fix for sql timeout and option type json utils Option type is now mapped from dapper nullable columns. Because Dapper is not really design to work with F# it was mapping null values to strings etc. Now if value is optioned in Model null will be mapped to none. Also added Json FSharp lib which maps Options back to null/value in json so that frontend doesn't get option objects. The sql timeout bug If chat was longer than 100 messages JOIN on message with Users caused some requests to timeout. I initially thought it was caused by bug in dapper regarding mapping null to string. Turns out it was actually caused by bug mentioned in https://github.com/npgsql/efcore.pg/issues/1599 and related issues. It seems timeouts stopped happening after bumping npgql and Dapper versions. --- DapperHelper.fs | 39 +++++++++++++++++++++++++++++++++++++++ Models.fs | 4 ++-- Program.fs | 15 +++++++++++++++ SigmaChatServer.fsproj | 7 +++++-- 4 files changed, 61 insertions(+), 4 deletions(-) create mode 100644 DapperHelper.fs diff --git a/DapperHelper.fs b/DapperHelper.fs new file mode 100644 index 0000000..63eb707 --- /dev/null +++ b/DapperHelper.fs @@ -0,0 +1,39 @@ +module Dapper.Extensions + +open System +open Dapper + +let extractValue (x: obj) = + match x with + | null -> null + | _ -> + match x.GetType().GetProperty("Value") with + | null -> x + | prop -> prop.GetValue(x) + +let (+>) (map: Map) (key, value) = map.Add(key, extractValue value) +let singleParam (key, value) = (Map.empty) +> (key, value) + +type OptionHandler<'T>() = + inherit SqlMapper.TypeHandler>() + + override __.SetValue(param, value) = + let valueOrNull = + match value with + | Some x -> box x + | None -> null + + param.Value <- valueOrNull + + override __.Parse value = + if isNull value || value = box DBNull.Value then + None + else + Some(value :?> 'T) + +let registerTypeHandlers () = + SqlMapper.AddTypeHandler(OptionHandler()) + SqlMapper.AddTypeHandler(OptionHandler()) + SqlMapper.AddTypeHandler(OptionHandler()) + SqlMapper.AddTypeHandler(OptionHandler()) + SqlMapper.AddTypeHandler(OptionHandler()) diff --git a/Models.fs b/Models.fs index 8051a5a..5e269ec 100644 --- a/Models.fs +++ b/Models.fs @@ -6,7 +6,7 @@ open System type MessageModel = { MessageId: int ChatId: int - UserNickname: string + UserNickname: string option Text: string DateCreated: DateTime } @@ -23,7 +23,7 @@ type Chat = [] type User = { Id: string - Email: string + Email: string option Nickname: string } [] diff --git a/Program.fs b/Program.fs index ab504b9..fc30cfc 100644 --- a/Program.fs +++ b/Program.fs @@ -23,6 +23,10 @@ open Microsoft.AspNetCore.Hosting open Microsoft.AspNetCore.Authentication.JwtBearer open Hub open Microsoft.IdentityModel.Claims +open Dapper.Extensions +open Newtonsoft.Json +open Microsoft.FSharpLu.Json +open Newtonsoft.Json.Serialization // --------------------------------- // Web app // --------------------------------- @@ -70,6 +74,9 @@ let configureApp (app: IApplicationBuilder) = .UseGiraffe(webApp) let configureServices (services: IServiceCollection) = + // stupid dapper config + registerTypeHandlers () |> ignore + services.AddTransient(fun serviceProvider -> // The configuration information is in appsettings.json let settings = serviceProvider.GetService() @@ -110,6 +117,14 @@ let configureServices (services: IServiceCollection) = // services.AddSingleton() services.AddGiraffe() |> ignore + let customSettings = JsonSerializerSettings() + customSettings.ContractResolver <- CamelCasePropertyNamesContractResolver() + // this is for options serializing striaght to just/null values + customSettings.Converters.Add(CompactUnionJsonConverter(true)) + + services.AddSingleton(NewtonsoftJson.Serializer(customSettings)) + |> ignore + let configureLogging (builder: ILoggingBuilder) = builder.AddConsole().AddDebug() |> ignore diff --git a/SigmaChatServer.fsproj b/SigmaChatServer.fsproj index df08646..9dcff05 100644 --- a/SigmaChatServer.fsproj +++ b/SigmaChatServer.fsproj @@ -6,15 +6,18 @@ true - + + + - + + From 6962aa39076693bff72da7950f5f49fcbdc30068 Mon Sep 17 00:00:00 2001 From: senbar Date: Thu, 15 Feb 2024 14:05:23 +0100 Subject: [PATCH 18/23] feature: added logic for blob storage; renamed db modules to query Added profile image upload based on azurite. Azurite has setup in docker compose and takes account and key from azurite.env. Profile pictures store is public, user model provides blob name which can be constructed into link on frontend provided front has azurite public facing url. Users profile pictures are stored in new table, I dunno why yet but it can be helpful in the future (also we would loose original file name). Renamed all Db modules into Queries for obvious reasons. --- BlobHandlers.fs | 64 +++++++++++++++++++++++++ HttpHandlers.fs | 4 +- Models.fs | 4 +- Program.fs | 19 ++++++++ Routing.fs | 7 ++- SigmaChatServer.fsproj | 8 ++-- WebPush.fs | 3 +- azurite.env | 1 + compose.yaml | 12 +++++ sql/{ChatDb.fs => ChatQueries.fs} | 36 +++++++------- sql/Migrations.fs | 14 +++++- sql/{UserDb.fs => UserQueries.fs} | 33 +++++++++++-- sql/{WebPushDb.fs => WebPushQueries.fs} | 2 +- 13 files changed, 173 insertions(+), 34 deletions(-) create mode 100644 BlobHandlers.fs create mode 100644 azurite.env rename sql/{ChatDb.fs => ChatQueries.fs} (82%) rename sql/{UserDb.fs => UserQueries.fs} (60%) rename sql/{WebPushDb.fs => WebPushQueries.fs} (95%) diff --git a/BlobHandlers.fs b/BlobHandlers.fs new file mode 100644 index 0000000..1c6937f --- /dev/null +++ b/BlobHandlers.fs @@ -0,0 +1,64 @@ +namespace SigmaChatServer + +module BlobHandlers = + + open Microsoft.AspNetCore.Http + open Giraffe + open System.Data + open SigmaChatServer.Models + open Npgsql + open Azure.Storage.Blobs + open System + open Giraffe.HttpStatusCodeHandlers.RequestErrors + open UserQueries + open System.IO + open UserQueries + + [] + type FormModel = { Image: IFormFile; Test: string } + // Check if file is an image based on MIME type + let isImage (contentType: string) = + match contentType with + | "image/jpeg" + | "image/png" + | "image/gif" -> true + | _ -> false + + let private processFileRequest (next: HttpFunc) (ctx: HttpContext) handler = + task { + match ctx.Request.HasFormContentType with + | true -> + let! form = ctx.Request.ReadFormAsync() |> Async.AwaitTask + let files = form.Files + + if files.Count > 0 then + let file = files.[0] + return! handler file + else + return! badRequest (text "No files uploaded") next ctx + | false -> return! badRequest (text "Unsupported media type") next ctx + } + + + let private uploadProfilePicture (userId: string) (next: HttpFunc) (ctx: HttpContext) (file: IFormFile) = + task { + let containerClient = ctx.GetService() + let guidName = Guid.NewGuid().ToString() + Path.GetExtension(file.FileName) + + let fileModel = + { UserId = userId + BlobName = guidName + OriginalFilename = file.FileName } + + let blobClient = containerClient.GetBlobClient(file.FileName) + use stream = file.OpenReadStream() + let! a = blobClient.UploadAsync(stream, true) + let! _ = upsertProfilePicture ctx fileModel + + + return! text blobClient.Uri.AbsoluteUri next ctx + } + + let profilePictureUploadHandler (next: HttpFunc) (ctx: HttpContext) = + let userId = ctx.User.Identity.Name + uploadProfilePicture userId next ctx |> processFileRequest next ctx diff --git a/HttpHandlers.fs b/HttpHandlers.fs index 09d4009..c2fc4f3 100644 --- a/HttpHandlers.fs +++ b/HttpHandlers.fs @@ -5,13 +5,13 @@ module HttpHandlers = open Microsoft.AspNetCore.Http open Giraffe open SigmaChatServer.Models - open SigmaChatServer.ChatDb + open SigmaChatServer.ChatQueries open System.Data open System open SigmaChatServer.WebPush open Hub open Microsoft.AspNetCore.SignalR - open UserDb + open UserQueries open System.Threading.Tasks let handleGetChats (chatId: int) (next: HttpFunc) (ctx: HttpContext) = diff --git a/Models.fs b/Models.fs index 5e269ec..c1f3c01 100644 --- a/Models.fs +++ b/Models.fs @@ -7,6 +7,7 @@ type MessageModel = { MessageId: int ChatId: int UserNickname: string option + UserProfilePicture: string option Text: string DateCreated: DateTime } @@ -24,7 +25,8 @@ type Chat = type User = { Id: string Email: string option - Nickname: string } + Nickname: string + ProfilePictureBlob: string option } [] type UpdateMeModel = { Nickname: string } diff --git a/Program.fs b/Program.fs index fc30cfc..c23db83 100644 --- a/Program.fs +++ b/Program.fs @@ -21,8 +21,10 @@ open Microsoft.Extensions.DependencyInjection open Microsoft.IdentityModel.Tokens open Microsoft.AspNetCore.Hosting open Microsoft.AspNetCore.Authentication.JwtBearer +open Azure.Storage.Blobs open Hub open Microsoft.IdentityModel.Claims +open Azure.Storage.Blobs.Models open Dapper.Extensions open Newtonsoft.Json open Microsoft.FSharpLu.Json @@ -84,6 +86,23 @@ let configureServices (services: IServiceCollection) = upcast connection) |> ignore + services.AddTransient(fun serviceProvider -> + let settings = serviceProvider.GetService() + let connectionString = settings.["BlobConnectionString"] + + let blobServiceClient = + new BlobServiceClient( + connectionString, + // Azurite seems to be working only with API version 2021-12-02 + new BlobClientOptions(BlobClientOptions.ServiceVersion.V2021_12_02) + ) + + let containerClient = blobServiceClient.GetBlobContainerClient("images") + do containerClient.CreateIfNotExists(PublicAccessType.Blob) |> ignore + + containerClient) + |> ignore + services.AddCors() |> ignore services.AddSignalR(fun conf -> diff --git a/Routing.fs b/Routing.fs index fc9c26b..37e779c 100644 --- a/Routing.fs +++ b/Routing.fs @@ -6,6 +6,7 @@ module Routing = open Microsoft.AspNetCore.Http open HttpHandlers open WebPush + open BlobHandlers let notLoggedIn = RequestErrors.UNAUTHORIZED "Basic" "" "You must be logged in." @@ -25,9 +26,11 @@ module Routing = subRoute "/db" (choose [ GET >=> updateSchema ]) subRoute "/messages" mustBeLoggedIn >=> (messages) subRoute "/user/me" mustBeLoggedIn - >=> (choose [ GET >=> handleGetUserMe; PATCH >=> handleUpdateMeProfile ]) + >=> (choose + [ subRoute "/profile-picture" POST >=> profilePictureUploadHandler + GET >=> handleGetUserMe + PATCH >=> handleUpdateMeProfile ]) subRoute "/callback" mustBeLoggedIn >=> (handleCallback) subRoute "/web-push/subscribe" mustBeLoggedIn >=> (handleNewSubscription) subRoute "/web-push/key" mustBeLoggedIn >=> (handleGetVapidKey) ]) - // subRoute "/web-push/custom-message" mustBeLoggedIn >=> (handlePushCustomMessage) ]) setStatusCode 404 >=> text "Not Found" ] diff --git a/SigmaChatServer.fsproj b/SigmaChatServer.fsproj index 9dcff05..d8b6eb7 100644 --- a/SigmaChatServer.fsproj +++ b/SigmaChatServer.fsproj @@ -6,6 +6,7 @@ true + @@ -20,12 +21,13 @@ - - - + + + + diff --git a/WebPush.fs b/WebPush.fs index 095f9c8..3357a11 100644 --- a/WebPush.fs +++ b/WebPush.fs @@ -4,8 +4,7 @@ module WebPush = open WebPush open Microsoft.AspNetCore.Http open Giraffe - open ChatDb - open WebPushDb + open WebPushQueries open Microsoft.Extensions.Configuration open SigmaChatServer.Models open System.Text.Json.Nodes diff --git a/azurite.env b/azurite.env new file mode 100644 index 0000000..3b412f5 --- /dev/null +++ b/azurite.env @@ -0,0 +1 @@ +AZURITE_ACCOUNTS="localaccount:amh2aGpodmg=" diff --git a/compose.yaml b/compose.yaml index 05217c8..12575ea 100644 --- a/compose.yaml +++ b/compose.yaml @@ -17,6 +17,18 @@ services: - POSTGRES_DB=SigmaChatDb networks: - sigmaChat + azurite: + image: mcr.microsoft.com/azure-storage/azurite:latest + hostname: azurite + restart: always + + ports: + - "10000:10000" + - "10001:10001" + volumes: + - ./azurite:/workspace + env_file: + - ./azurite.env volumes: sql_data: diff --git a/sql/ChatDb.fs b/sql/ChatQueries.fs similarity index 82% rename from sql/ChatDb.fs rename to sql/ChatQueries.fs index 1929c6e..d545879 100644 --- a/sql/ChatDb.fs +++ b/sql/ChatQueries.fs @@ -1,6 +1,6 @@ namespace SigmaChatServer -module ChatDb = +module ChatQueries = open SigmaChatServer.Models open Microsoft.AspNetCore.Http @@ -41,19 +41,6 @@ module ChatDb = return! version |> generateMigrationScript Migrations |> connection.QueryAsync } - let getChat (ctx: HttpContext) (chatId: int) = - task { - use connection = ctx.GetService() - let sql = """SELECT * FROM "Chats" WHERE "ChatId" = @chatId""" - let data = {| chatId = chatId |} - - try - let! chat = connection.QueryFirstAsync(sql, data) - return Some chat - with :? InvalidOperationException -> - return None - } - let postChat (ctx: HttpContext) = task { use connection = ctx.GetService() @@ -87,12 +74,27 @@ module ChatDb = use connection = ctx.GetService() let sql = - """SELECT "Messages".*, "Users"."Nickname" as "UserNickname" FROM "Messages" - LEFT JOIN "Users" on "Messages"."UserId"="Users"."Id" + """SELECT "Messages".*, "Users"."Nickname" as "UserNickname", "UserProfilePictures"."BlobName" as "UserProfilePicture" FROM "Messages" + LEFT JOIN "Users" ON "Messages"."UserId"="Users"."Id" + LEFT JOIN "UserProfilePictures" ON "Users"."Id" = "UserProfilePictures"."UserId" WHERE "ChatId"= @chatId - ORDER BY "MessageId";""" + ORDER BY "MessageId" ;""" let data = {| chatId = chatId |} + let! messages = connection.QueryAsync(sql, data) return messages } + + let getChat (ctx: HttpContext) (chatId: int) = + task { + let! messages = getMessages ctx chatId + + try + return + Some + { ChatId = chatId + Messages = messages |> Seq.toList } + with :? InvalidOperationException -> + return None + } diff --git a/sql/Migrations.fs b/sql/Migrations.fs index a3738fe..93198e1 100644 --- a/sql/Migrations.fs +++ b/sql/Migrations.fs @@ -53,7 +53,7 @@ module Migrations = ); """ """ - DROP TABLE "PushSubscriptions"; + DROP TABLE "PushSubscriptions"; CREATE TABLE "PushSubscriptions"( "UserId" VARCHAR(50) PRIMARY KEY, @@ -62,4 +62,16 @@ module Migrations = FOREIGN KEY ("UserId") REFERENCES "Users" ("Id") ); + """ + """ + CREATE TABLE "UserProfilePictures"( + "UserId" VARCHAR(50) PRIMARY KEY, + "BlobName" VARCHAR(50) NOT NULL, + "DateCreated" TIMESTAMP NOT NULL, + "OriginalFilename" VARCHAR(255) NOT NULL, + FOREIGN KEY ("UserId") + REFERENCES "Users" ("Id") + ); + + CREATE UNIQUE INDEX idx_UserProfilePictures_BlobName ON "UserProfilePictures" ("BlobName"); """ |] diff --git a/sql/UserDb.fs b/sql/UserQueries.fs similarity index 60% rename from sql/UserDb.fs rename to sql/UserQueries.fs index ddf8be0..085cf36 100644 --- a/sql/UserDb.fs +++ b/sql/UserQueries.fs @@ -1,13 +1,12 @@ namespace SigmaChatServer -module UserDb = +module UserQueries = open Microsoft.AspNetCore.Http open Giraffe open System.Data open Dapper open SigmaChatServer.Models open System - open Microsoft.FSharp.Core let createUser (ctx: HttpContext) (userId: string) = task { @@ -43,7 +42,10 @@ module UserDb = task { use connection = ctx.GetService() - let sql = """SELECT * FROM "Users" WHERE "Id" = @userId;""" + let sql = + """SELECT "Users".*, "UserProfilePictures"."BlobName" as "ProfilePictureBlob" FROM "Users" + LEFT JOIN "UserProfilePictures" ON "Id" = "UserId" + WHERE "Id" = @userId;""" let sqlParams = {| userId = userId |} @@ -56,7 +58,7 @@ module UserDb = return optioned } - + let getAllUserIds (ctx: HttpContext) = task { use connection = ctx.GetService() @@ -66,4 +68,25 @@ module UserDb = let! userIds = connection.QueryAsync(sql) return userIds } - + + type ProfilePictureModel = + { UserId: string + BlobName: string + OriginalFilename: string } + + let upsertProfilePicture (ctx: HttpContext) (model: ProfilePictureModel) = + task { + use connection = ctx.GetService() + + let sql = + """ + INSERT INTO "UserProfilePictures" ("UserId", "BlobName", "OriginalFilename", "DateCreated") + VALUES (@userId, @blobName, @originalFilename, NOW()) + ON CONFLICT ("UserId") DO UPDATE + SET "BlobName" = EXCLUDED."BlobName", + "OriginalFilename" = EXCLUDED."OriginalFilename", + "DateCreated" = NOW(); + """ + + return! connection.QueryAsync(sql, model) + } diff --git a/sql/WebPushDb.fs b/sql/WebPushQueries.fs similarity index 95% rename from sql/WebPushDb.fs rename to sql/WebPushQueries.fs index 0c8a9f1..d19b855 100644 --- a/sql/WebPushDb.fs +++ b/sql/WebPushQueries.fs @@ -1,6 +1,6 @@ namespace SigmaChatServer -module WebPushDb = +module WebPushQueries = open Microsoft.AspNetCore.Http open Giraffe open System.Data From ad3992cbbb7afc68fcc2863d1a0422ac797925a3 Mon Sep 17 00:00:00 2001 From: senbar Date: Mon, 19 Feb 2024 20:48:25 +0100 Subject: [PATCH 19/23] Feature: pagination Added pagination for chat messages. Client includes last fetched message creation date in query params of messages get to paginate. --- .gitignore | 1 + HttpHandlers.fs | 12 +++++++++--- Program.fs | 1 - Routing.fs | 2 +- _appsettings.json | 17 +++++++++++++++++ _azurite.env_ | 1 + azurite.env | 1 - sql/ChatQueries.fs | 16 ++++++++++------ 8 files changed, 39 insertions(+), 12 deletions(-) create mode 100644 _appsettings.json create mode 100644 _azurite.env_ delete mode 100644 azurite.env diff --git a/.gitignore b/.gitignore index 933078f..6e62704 100644 --- a/.gitignore +++ b/.gitignore @@ -256,3 +256,4 @@ paket-files/ appsettings.*.json +azurite.env diff --git a/HttpHandlers.fs b/HttpHandlers.fs index c2fc4f3..c576016 100644 --- a/HttpHandlers.fs +++ b/HttpHandlers.fs @@ -38,10 +38,16 @@ module HttpHandlers = return! json Ok next ctx } - let handleGetMessages (chatId: int) (next: HttpFunc) (ctx: HttpContext) = + let handleGetMessages (chatId: int, paginationDate: string) (next: HttpFunc) (ctx: HttpContext) = task { - let! chat = getMessages ctx chatId - return! json chat next ctx + return! + match DateTime.TryParse(paginationDate) with + | true, date -> + task { + let! messages = getMessages ctx chatId (date.ToUniversalTime()) + return! json messages next ctx + } + | _ -> RequestErrors.BAD_REQUEST (text "Couldnt parse pagination date") next ctx } let handlePostMessage (next: HttpFunc) (ctx: HttpContext) = diff --git a/Program.fs b/Program.fs index c23db83..efbb4cd 100644 --- a/Program.fs +++ b/Program.fs @@ -159,5 +159,4 @@ let main args = |> ignore) .Build() .Run() - 0 diff --git a/Routing.fs b/Routing.fs index 37e779c..ed9a4e3 100644 --- a/Routing.fs +++ b/Routing.fs @@ -14,7 +14,7 @@ module Routing = requiresAuthentication notLoggedIn let messages: HttpFunc -> HttpContext -> HttpFuncResult = - choose [ GET >=> routef "/%i" handleGetMessages; POST >=> handlePostMessage ] + choose [ GET >=> routef "/%i/%s" handleGetMessages; POST >=> handlePostMessage ] let routing: HttpFunc -> HttpContext -> HttpFuncResult = choose diff --git a/_appsettings.json b/_appsettings.json new file mode 100644 index 0000000..d0a486d --- /dev/null +++ b/_appsettings.json @@ -0,0 +1,17 @@ +{ + "DbConnectionString": "User ID=sa;Password=JHVHjhvh!;Host=localhost;Port=5432;Database=SigmaChatDb;Pooling=true;Minimum Pool Size=0;Maximum Pool Size=100;Connection Lifetime=0;SSL Mode=Disable;Trust Server Certificate=true", + "BlobConnectionString": "", + "Vapid":{ + "Subject":"", + "Private":"", + "Public":"" + }, + "Logging": { + "LogLevel": { + "Default": "Information", + "Microsoft": "Warning", + "Microsoft.Hosting.Lifetime": "Information" + } + }, + "AllowedHosts": "*" +} diff --git a/_azurite.env_ b/_azurite.env_ new file mode 100644 index 0000000..c10cd2e --- /dev/null +++ b/_azurite.env_ @@ -0,0 +1 @@ +AZURITE_ACCOUNTS="accountname:base64 key" diff --git a/azurite.env b/azurite.env deleted file mode 100644 index 3b412f5..0000000 --- a/azurite.env +++ /dev/null @@ -1 +0,0 @@ -AZURITE_ACCOUNTS="localaccount:amh2aGpodmg=" diff --git a/sql/ChatQueries.fs b/sql/ChatQueries.fs index d545879..d305786 100644 --- a/sql/ChatQueries.fs +++ b/sql/ChatQueries.fs @@ -69,18 +69,22 @@ module ChatQueries = return createdMessage } - let getMessages (ctx: HttpContext) (chatId: int) = + let getMessages (ctx: HttpContext) (chatId: int) (paginationDate: DateTime) = task { use connection = ctx.GetService() let sql = - """SELECT "Messages".*, "Users"."Nickname" as "UserNickname", "UserProfilePictures"."BlobName" as "UserProfilePicture" FROM "Messages" + """SELECT * FROM (SELECT "Messages".*, "Users"."Nickname" as "UserNickname", "UserProfilePictures"."BlobName" as "UserProfilePicture" FROM "Messages" LEFT JOIN "Users" ON "Messages"."UserId"="Users"."Id" LEFT JOIN "UserProfilePictures" ON "Users"."Id" = "UserProfilePictures"."UserId" - WHERE "ChatId"= @chatId - ORDER BY "MessageId" ;""" + WHERE "ChatId"= @chatId AND "Messages"."DateCreated" < @paginationDate + ORDER BY "MessageId" DESC + LIMIT 30) + ORDER BY "MessageId" ASC;""" - let data = {| chatId = chatId |} + let data = + {| chatId = chatId + paginationDate = paginationDate |} let! messages = connection.QueryAsync(sql, data) return messages @@ -88,7 +92,7 @@ module ChatQueries = let getChat (ctx: HttpContext) (chatId: int) = task { - let! messages = getMessages ctx chatId + let! messages = getMessages ctx chatId DateTime.UtcNow try return From 6344dabc4c6b59d7d3ff2f56bf2fa4b8ea38b868 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Izabela=20Sowi=C5=84ska?= <103259729+izabelasowi@users.noreply.github.com> Date: Thu, 28 Mar 2024 14:16:23 +0100 Subject: [PATCH 20/23] Add: build + deployment pipeline --- .github/workflows/checkout.yaml | 50 +++++++++++++++++++++++++++++++++ compose.prod.yaml | 39 +++++++++++++++++++++++++ 2 files changed, 89 insertions(+) create mode 100644 .github/workflows/checkout.yaml create mode 100644 compose.prod.yaml diff --git a/.github/workflows/checkout.yaml b/.github/workflows/checkout.yaml new file mode 100644 index 0000000..77ccafc --- /dev/null +++ b/.github/workflows/checkout.yaml @@ -0,0 +1,50 @@ +on: + push: + branches: + - development + +env: + IMAGE_NAME: sigmaproductions/sigmachatserver + +jobs: + build: + runs-on: [self-hosted, build] + steps: + - name: Set build tag + run: | + echo "IMAGE_TAG=$(git rev-parse --short HEAD)" >> "$GITHUB_ENV" + - name: Checkout repository + uses: actions/checkout@v2 + - name: Configure appsettings.json + env: + appsettings: ${{ secrets.appsettings }} + run: | + echo "$appsettings" > appsettings.json + - name: Login to Docker Hub + uses: docker/login-action@v3 + with: + username: ${{ secrets.DOCKERHUB_USERNAME }} + password: ${{ secrets.DOCKERHUB_TOKEN }} + - name: Build the Docker image + run: docker build . --file Dockerfile --tag ${IMAGE_NAME}:${IMAGE_TAG} + - name: Publish the Docker image + run: docker push ${IMAGE_NAME}:${IMAGE_TAG} + deploy: + needs: build + runs-on: [self-hosted, deploy] + steps: + - name: Set build tag + run: | + echo "IMAGE_TAG=$(git rev-parse --short HEAD)" >> "$GITHUB_ENV" + - name: Checkout repository + uses: actions/checkout@v2 + - name: Login to Docker Hub + uses: docker/login-action@v3 + with: + username: ${{ secrets.DOCKERHUB_USERNAME }} + password: ${{ secrets.DOCKERHUB_TOKEN }} + - name: Pull and deploy + env: + AZURITE_ACCOUNTS: ${{ secrets.azurite_accounts }} + run: docker-compose -f compose.prod.yaml pull && + docker-compose -f compose.prod.yaml up -d diff --git a/compose.prod.yaml b/compose.prod.yaml new file mode 100644 index 0000000..5eac698 --- /dev/null +++ b/compose.prod.yaml @@ -0,0 +1,39 @@ +services: + backend: + image: sigmaproductions/sigmachatserver:${IMAGE_TAG} + ports: + - "5000:80" + networks: + - sigmaChat + sqlServer: + image: "postgres" + volumes: + - sql_data:/var/lib/mysql + ports: + - "5432:5432" + environment: + - POSTGRES_PASSWORD=JHVHjhvh! + - POSTGRES_USER=sa + - POSTGRES_DB=SigmaChatDb + networks: + - sigmaChat + azurite: + image: mcr.microsoft.com/azure-storage/azurite:latest + hostname: azurite + restart: always + + ports: + - "10000:10000" + - "10001:10001" + volumes: + - azurite:/workspace + environment: + - AZURITE_ACCOUNTS=${AZURITE_ACCOUNTS} + +volumes: + sql_data: + azurite: + +networks: + sigmaChat: + name: sigmaChat From d4af7977870ae7fc62e5c184c7444a2ce87e097b Mon Sep 17 00:00:00 2001 From: senbar Date: Tue, 23 Apr 2024 22:06:16 +0200 Subject: [PATCH 21/23] feat: Migrate to minIO and finish up users profile pics migrated form azurite because it was pain in the ass to use in production with no tooling for storage explore. Added minio client and compose setup, on 9000 admin ui is available to explore buckets and objects. Added mapping of public facing url for profile pictures to user DTO model, minio should be publicly accessible for this to work since this is just url straight to that. Added setup of buckets with public access policies on database schema setup. --- .gitignore | 1 + BlobHandlers.fs | 46 +++++++++++++++++++++++++-------- HttpHandlers.fs | 58 ++++++++++++++++++++++++++++++++++++++++-- Program.fs | 37 ++++++++++++--------------- SigmaChatServer.fsproj | 3 ++- _appsettings.json | 6 ++++- compose.yaml | 23 +++++++++-------- 7 files changed, 129 insertions(+), 45 deletions(-) diff --git a/.gitignore b/.gitignore index 6e62704..2793732 100644 --- a/.gitignore +++ b/.gitignore @@ -256,4 +256,5 @@ paket-files/ appsettings.*.json +appsettings.json azurite.env diff --git a/BlobHandlers.fs b/BlobHandlers.fs index 1c6937f..4938128 100644 --- a/BlobHandlers.fs +++ b/BlobHandlers.fs @@ -13,6 +13,9 @@ module BlobHandlers = open UserQueries open System.IO open UserQueries + open Minio + open Minio.DataModel.Args + open Microsoft.Extensions.Configuration [] type FormModel = { Image: IFormFile; Test: string } @@ -24,7 +27,11 @@ module BlobHandlers = | "image/gif" -> true | _ -> false - let private processFileRequest (next: HttpFunc) (ctx: HttpContext) handler = + let getPublicBlobUrl (config: IConfiguration) blobName = + let minioSettings = config.GetSection("Minio") + minioSettings.GetValue("PublicBucketUrl") + blobName + + let private processHttpFileRequest (next: HttpFunc) (ctx: HttpContext) handler = task { match ctx.Request.HasFormContentType with | true -> @@ -39,26 +46,45 @@ module BlobHandlers = | false -> return! badRequest (text "Unsupported media type") next ctx } - let private uploadProfilePicture (userId: string) (next: HttpFunc) (ctx: HttpContext) (file: IFormFile) = task { - let containerClient = ctx.GetService() - let guidName = Guid.NewGuid().ToString() + Path.GetExtension(file.FileName) + let containerClient = ctx.GetService() + let minioSettings = ctx.GetService().GetSection("Minio") + + let guid = Guid.NewGuid().ToString() + Path.GetExtension(file.FileName) let fileModel = { UserId = userId - BlobName = guidName + BlobName = guid OriginalFilename = file.FileName } - let blobClient = containerClient.GetBlobClient(file.FileName) use stream = file.OpenReadStream() - let! a = blobClient.UploadAsync(stream, true) - let! _ = upsertProfilePicture ctx fileModel + let putArgs = + (new PutObjectArgs()) + .WithBucket(minioSettings.GetValue("PublicBucketName")) + .WithObject(fileModel.BlobName) + .WithObjectSize(stream.Length) + .WithContentType(file.ContentType) + .WithStreamData(stream) - return! text blobClient.Uri.AbsoluteUri next ctx + let! _ = containerClient.PutObjectAsync(putArgs) + let! _ = upsertProfilePicture ctx fileModel + + let blobUrl = getPublicBlobUrl minioSettings fileModel.BlobName + return! text blobUrl next ctx } let profilePictureUploadHandler (next: HttpFunc) (ctx: HttpContext) = let userId = ctx.User.Identity.Name - uploadProfilePicture userId next ctx |> processFileRequest next ctx + uploadProfilePicture userId next ctx |> processHttpFileRequest next ctx + + +//Note: +// let presignesArgs = +// (new PresignedGetObjectArgs()) +// .WithBucket("public-jehovahs-pictures") +// .WithObject(guidName) +// .WithExpiry(60) + +// let! z = containerClient.PresignedGetObjectAsync(presignesArgs) diff --git a/HttpHandlers.fs b/HttpHandlers.fs index c576016..d16f884 100644 --- a/HttpHandlers.fs +++ b/HttpHandlers.fs @@ -12,7 +12,11 @@ module HttpHandlers = open Hub open Microsoft.AspNetCore.SignalR open UserQueries + open SigmaChatServer.BlobHandlers open System.Threading.Tasks + open Microsoft.Extensions.Configuration + open Minio.DataModel.Args + open Minio let handleGetChats (chatId: int) (next: HttpFunc) (ctx: HttpContext) = task { @@ -34,7 +38,41 @@ module HttpHandlers = let updateSchema (next: HttpFunc) (ctx: HttpContext) = task { let connection = ctx.GetService() - let! res = setupDatabaseSchema connection + + do setupDatabaseSchema connection |> ignore + + let settings = ctx.GetService() + let client = ctx.GetService() + let minioSection = settings.GetSection("Minio") + + let checkArgs = + (new BucketExistsArgs()).WithBucket(minioSection.["PublicBucketName"]) + + do + client.BucketExistsAsync(checkArgs) + |> (fun exists -> + task { + let! exists = exists + + return + match exists with + | false -> + let createArgs = + (new MakeBucketArgs()).WithBucket(minioSection.["PublicBucketName"]) + + let policy = minioSection.["Policy"] + + let policyArgs = + (new SetPolicyArgs()) + .WithBucket(minioSection.["PublicBucketName"]) + .WithPolicy(policy) + + client.MakeBucketAsync(createArgs) |> ignore + client.SetPolicyAsync(policyArgs) |> ignore + | true -> () + }) + |> ignore + return! json Ok next ctx } @@ -68,6 +106,13 @@ module HttpHandlers = return! json createdMessage next ctx } + //Note: left for next story + // let handlePostAttachmentMessage (next:HttpFunc)(ctx: HttpContext) model= + // task{ + + + // } + let! createMessageModel = ctx.BindJsonAsync() return! @@ -103,9 +148,18 @@ module HttpHandlers = let userId = ctx.User.Identity.Name let! user = getUser ctx userId + let embelishWithProfileUrl (u: User) = + let configuration = ctx.GetService() + + match u.ProfilePictureBlob with + | Some profilePictureBlob -> + getPublicBlobUrl configuration profilePictureBlob + |> fun url -> { u with ProfilePictureBlob = Some url } + | None -> u + let res = match user with - | Some u -> json u next ctx + | Some u -> json (u |> embelishWithProfileUrl) next ctx | None -> RequestErrors.UNAUTHORIZED "Basic" "" "You must be logged in." next ctx return! res diff --git a/Program.fs b/Program.fs index efbb4cd..0abed04 100644 --- a/Program.fs +++ b/Program.fs @@ -29,6 +29,8 @@ open Dapper.Extensions open Newtonsoft.Json open Microsoft.FSharpLu.Json open Newtonsoft.Json.Serialization +open Minio +open Minio.DataModel.Args // --------------------------------- // Web app // --------------------------------- @@ -86,21 +88,23 @@ let configureServices (services: IServiceCollection) = upcast connection) |> ignore - services.AddTransient(fun serviceProvider -> + services.AddTransient(fun serviceProvider -> let settings = serviceProvider.GetService() - let connectionString = settings.["BlobConnectionString"] - let blobServiceClient = - new BlobServiceClient( - connectionString, - // Azurite seems to be working only with API version 2021-12-02 - new BlobClientOptions(BlobClientOptions.ServiceVersion.V2021_12_02) - ) + let minioSection = settings.GetSection("Minio") + let endpoint = minioSection.["Endpoint"] + let publicKey = minioSection.["AccessKey"] + let secretKey = minioSection.["SecretKey"] - let containerClient = blobServiceClient.GetBlobContainerClient("images") - do containerClient.CreateIfNotExists(PublicAccessType.Blob) |> ignore + let blobServiceClient = new MinioClient() - containerClient) + let client = + blobServiceClient + .WithEndpoint(endpoint) + .WithCredentials(publicKey, secretKey) + .Build() + + client) |> ignore services.AddCors() |> ignore @@ -124,16 +128,6 @@ let configureServices (services: IServiceCollection) = options.TokenValidationParameters <- TokenValidationParameters(NameClaimType = ClaimTypes.NameIdentifier)) |> ignore - // services.AddAuthorization() |> ignore - // => options { - // options.AddPolicy( - // "read:admin-messages", - // => policy { policy.Requirements.Add(new RbacRequirement("read:admin-messages")) } - // ) - // } - - - // services.AddSingleton() services.AddGiraffe() |> ignore let customSettings = JsonSerializerSettings() @@ -159,4 +153,5 @@ let main args = |> ignore) .Build() .Run() + 0 diff --git a/SigmaChatServer.fsproj b/SigmaChatServer.fsproj index d8b6eb7..d812597 100644 --- a/SigmaChatServer.fsproj +++ b/SigmaChatServer.fsproj @@ -14,6 +14,7 @@ + @@ -26,8 +27,8 @@ - + diff --git a/_appsettings.json b/_appsettings.json index d0a486d..2fa4549 100644 --- a/_appsettings.json +++ b/_appsettings.json @@ -1,6 +1,10 @@ { "DbConnectionString": "User ID=sa;Password=JHVHjhvh!;Host=localhost;Port=5432;Database=SigmaChatDb;Pooling=true;Minimum Pool Size=0;Maximum Pool Size=100;Connection Lifetime=0;SSL Mode=Disable;Trust Server Certificate=true", - "BlobConnectionString": "", + "MinIO":{ + "Endpoint":"", + "AccessKey":"", + "SecretKey":"" + }, "Vapid":{ "Subject":"", "Private":"", diff --git a/compose.yaml b/compose.yaml index 12575ea..1da833d 100644 --- a/compose.yaml +++ b/compose.yaml @@ -17,21 +17,24 @@ services: - POSTGRES_DB=SigmaChatDb networks: - sigmaChat - azurite: - image: mcr.microsoft.com/azure-storage/azurite:latest - hostname: azurite - restart: always - + minio: + image: docker.io/bitnami/minio:2022 ports: - - "10000:10000" - - "10001:10001" + - "9000:9000" + - "9001:9001" + networks: + - sigmaChat volumes: - - ./azurite:/workspace - env_file: - - ./azurite.env + - "minio_data:/data" + environment: + - MINIO_ROOT_USER=admin + - MINIO_ROOT_PASSWORD=jhvhJHVH! + - MINIO_DEFAULT_BUCKETS=jehovahs-pictures volumes: sql_data: + minio_data: + driver: local networks: sigmaChat: From e281867a820ab41b52281f412688ee06a5cf325f Mon Sep 17 00:00:00 2001 From: danielkluska Date: Wed, 24 Apr 2024 20:32:32 +0200 Subject: [PATCH 22/23] fix: Update PostgreSQL data volume path --- compose.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/compose.yaml b/compose.yaml index 1da833d..f327dcd 100644 --- a/compose.yaml +++ b/compose.yaml @@ -8,7 +8,7 @@ services: sqlServer: image: "postgres" volumes: - - sql_data:/var/lib/mysql + - sql_data:/var/lib/postgresql/data ports: - "5432:5432" environment: From 3206e13033e51f1c99a31292ba4354b4b53d23bb Mon Sep 17 00:00:00 2001 From: Bartosz Sendek Date: Sun, 4 Jan 2026 17:39:07 +0100 Subject: [PATCH 23/23] fix: Remove clutter from dev setup get rid off azurite stuff, remove appsettings from git index, cleanup compose for minio since older image is no longer working --- .gitignore | 5 +---- _azurite.env_ | 1 - appsettings.json | 16 ---------------- compose.prod.yaml | 2 ++ compose.yaml | 6 +++--- 5 files changed, 6 insertions(+), 24 deletions(-) delete mode 100644 _azurite.env_ delete mode 100644 appsettings.json diff --git a/.gitignore b/.gitignore index 2793732..07b68d3 100644 --- a/.gitignore +++ b/.gitignore @@ -254,7 +254,4 @@ paket-files/ .idea/ *.sln.iml - -appsettings.*.json -appsettings.json -azurite.env +appsettings.json \ No newline at end of file diff --git a/_azurite.env_ b/_azurite.env_ deleted file mode 100644 index c10cd2e..0000000 --- a/_azurite.env_ +++ /dev/null @@ -1 +0,0 @@ -AZURITE_ACCOUNTS="accountname:base64 key" diff --git a/appsettings.json b/appsettings.json deleted file mode 100644 index 207afcb..0000000 --- a/appsettings.json +++ /dev/null @@ -1,16 +0,0 @@ -{ - "DbConnectionString": "User ID=sa;Password=JHVHjhvh!;Host=localhost;Port=5432;Database=SigmaChatDb;Pooling=true;Minimum Pool Size=0;Maximum Pool Size=100;Connection Lifetime=0;SSL Mode=Disable;Trust Server Certificate=true", - "Vapid":{ - "Subject":"", - "Private":"", - "Public":"" - }, - "Logging": { - "LogLevel": { - "Default": "Information", - "Microsoft": "Warning", - "Microsoft.Hosting.Lifetime": "Information" - } - }, - "AllowedHosts": "*" -} diff --git a/compose.prod.yaml b/compose.prod.yaml index 5eac698..2d60f96 100644 --- a/compose.prod.yaml +++ b/compose.prod.yaml @@ -1,3 +1,5 @@ +# Everything incorrect todo fix + services: backend: image: sigmaproductions/sigmachatserver:${IMAGE_TAG} diff --git a/compose.yaml b/compose.yaml index 1da833d..93e83d6 100644 --- a/compose.yaml +++ b/compose.yaml @@ -5,7 +5,7 @@ services: - "5000:80" networks: - sigmaChat - sqlServer: + postgres: image: "postgres" volumes: - sql_data:/var/lib/mysql @@ -18,7 +18,8 @@ services: networks: - sigmaChat minio: - image: docker.io/bitnami/minio:2022 + image: minio/minio:latest + entrypoint: ["sh", "-c", "minio server /data --console-address ':9001'"] ports: - "9000:9000" - "9001:9001" @@ -30,7 +31,6 @@ services: - MINIO_ROOT_USER=admin - MINIO_ROOT_PASSWORD=jhvhJHVH! - MINIO_DEFAULT_BUCKETS=jehovahs-pictures - volumes: sql_data: minio_data: