diff --git a/Dockerfile b/Dockerfile index d2cfa13..e5363a6 100644 --- a/Dockerfile +++ b/Dockerfile @@ -1,4 +1,4 @@ -FROM mcr.microsoft.com/dotnet/sdk:8.0.302-jammy AS build-env +FROM mcr.microsoft.com/dotnet/sdk:8.0.402-jammy AS build-env ### workaround for testcontainers resource reaper issue ARG RESOURCE_REAPER_SESSION_ID="00000000-0000-0000-0000-000000000000" diff --git a/global.json b/global.json index 2434529..686e090 100644 --- a/global.json +++ b/global.json @@ -1,5 +1,5 @@ { "sdk": { - "version": "8.0.302" + "version": "8.0.402" } } \ No newline at end of file diff --git a/src/VahterBanBot.Tests/BanTests.fs b/src/VahterBanBot.Tests/BanTests.fs index e2853f9..947c621 100644 --- a/src/VahterBanBot.Tests/BanTests.fs +++ b/src/VahterBanBot.Tests/BanTests.fs @@ -3,6 +3,7 @@ module VahterBanBot.Tests.BanTests open System.Net open VahterBanBot.Tests.ContainerTestBase open VahterBanBot.Tests.TgMessageUtils +open VahterBanBot.Utils open Xunit open Xunit.Extensions.AssemblyFixture @@ -16,12 +17,12 @@ type BanTests(fixture: VahterTestContainers) = // send the ban message let! banResp = - Tg.replyMsg(msgUpdate.Message, "/ban", fixture.Vahters[0]) + Tg.replyMsg(msgUpdate.Message.Value, "/ban", fixture.Vahters[0]) |> fixture.SendMessage Assert.Equal(HttpStatusCode.OK, banResp.StatusCode) // assert that the message got banned - let! msgBanned = fixture.MessageBanned msgUpdate.Message + let! msgBanned = fixture.MessageBanned msgUpdate.Message.Value Assert.True msgBanned } @@ -33,12 +34,12 @@ type BanTests(fixture: VahterTestContainers) = // send the ban message from a non-admin user let! banResp = - Tg.replyMsg(msgUpdate.Message, "/ban", Tg.user()) + Tg.replyMsg(msgUpdate.Message.Value, "/ban", Tg.user()) |> fixture.SendMessage Assert.Equal(HttpStatusCode.OK, banResp.StatusCode) // assert that the message NOT banned - let! msgNotBanned = fixture.MessageBanned msgUpdate.Message + let! msgNotBanned = fixture.MessageBanned msgUpdate.Message.Value Assert.False msgNotBanned } @@ -50,12 +51,12 @@ type BanTests(fixture: VahterTestContainers) = // send the ban message let! banResp = - Tg.replyMsg(msgUpdate.Message, "/ban", fixture.Vahters[0]) + Tg.replyMsg(msgUpdate.Message.Value, "/ban", fixture.Vahters[0]) |> fixture.SendMessage Assert.Equal(HttpStatusCode.OK, banResp.StatusCode) // assert that the message NOT banned - let! msgNotBanned = fixture.MessageBanned msgUpdate.Message + let! msgNotBanned = fixture.MessageBanned msgUpdate.Message.Value Assert.False msgNotBanned } @@ -67,12 +68,12 @@ type BanTests(fixture: VahterTestContainers) = // send the ban message let! banResp = - Tg.replyMsg(msgUpdate.Message, "/ban", fixture.Vahters[1]) + Tg.replyMsg(msgUpdate.Message.Value, "/ban", fixture.Vahters[1]) |> fixture.SendMessage Assert.Equal(HttpStatusCode.OK, banResp.StatusCode) // assert that the message NOT banned - let! msgNotBanned = fixture.MessageBanned msgUpdate.Message + let! msgNotBanned = fixture.MessageBanned msgUpdate.Message.Value Assert.False msgNotBanned } @@ -84,22 +85,22 @@ type BanTests(fixture: VahterTestContainers) = // send the ban message let! banResp = - Tg.replyMsg(msgUpdate.Message, "/ban", fixture.Vahters[0]) + Tg.replyMsg(msgUpdate.Message.Value, "/ban", fixture.Vahters[0]) |> fixture.SendMessage Assert.Equal(HttpStatusCode.OK, banResp.StatusCode) // assert that the message got banned - let! msgBanned = fixture.MessageBanned msgUpdate.Message + let! msgBanned = fixture.MessageBanned msgUpdate.Message.Value Assert.True msgBanned // send the unban message from another vahter let! banResp = - Tg.quickMsg($"/unban {msgUpdate.Message.From.Id}", chat = fixture.ChatsToMonitor[0], from = fixture.Vahters[1]) + Tg.quickMsg($"/unban {msgUpdate.Message.Value.FromId}", chat = fixture.ChatsToMonitor[0], from = fixture.Vahters[1]) |> fixture.SendMessage Assert.Equal(HttpStatusCode.OK, banResp.StatusCode) // assert that the message no longer banned - let! msgBanned = fixture.MessageBanned msgUpdate.Message + let! msgBanned = fixture.MessageBanned msgUpdate.Message.Value Assert.False msgBanned } @@ -111,22 +112,22 @@ type BanTests(fixture: VahterTestContainers) = // send the ban message let! banResp = - Tg.replyMsg(msgUpdate.Message, "/ban", fixture.Vahters[0]) + Tg.replyMsg(msgUpdate.Message.Value, "/ban", fixture.Vahters[0]) |> fixture.SendMessage Assert.Equal(HttpStatusCode.OK, banResp.StatusCode) // assert that the message got banned - let! msgBanned = fixture.MessageBanned msgUpdate.Message + let! msgBanned = fixture.MessageBanned msgUpdate.Message.Value Assert.True msgBanned // send the unban message from a random user let! banResp = - Tg.quickMsg($"/unban {msgUpdate.Message.From.Id}", chat = fixture.ChatsToMonitor[0]) + Tg.quickMsg($"/unban {msgUpdate.Message.Value.FromId}", chat = fixture.ChatsToMonitor[0]) |> fixture.SendMessage Assert.Equal(HttpStatusCode.OK, banResp.StatusCode) // assert that the message still banned - let! msgBanned = fixture.MessageBanned msgUpdate.Message + let! msgBanned = fixture.MessageBanned msgUpdate.Message.Value Assert.True msgBanned } diff --git a/src/VahterBanBot.Tests/BaseTests.fs b/src/VahterBanBot.Tests/BaseTests.fs index 7a01316..b4cbcce 100644 --- a/src/VahterBanBot.Tests/BaseTests.fs +++ b/src/VahterBanBot.Tests/BaseTests.fs @@ -3,7 +3,7 @@ module BaseTests open System open System.Net.Http open System.Text -open Telegram.Bot.Types +open Funogram.Telegram.Types open VahterBanBot.Tests.ContainerTestBase open Xunit open Xunit.Extensions.AssemblyFixture @@ -28,7 +28,7 @@ type BaseTests(fixture: VahterTestContainers) = [] let ``Should be possible to interact with the bot`` () = task { - let! resp = Update(Id = 123) |> fixture.SendMessage + let! resp = Update.Create(updateId = 123) |> fixture.SendMessage let! body = resp.Content.ReadAsStringAsync() Assert.Equal(System.Net.HttpStatusCode.OK, resp.StatusCode) Assert.Equal("null", body) diff --git a/src/VahterBanBot.Tests/ContainerTestBase.fs b/src/VahterBanBot.Tests/ContainerTestBase.fs index 8fee468..e87e36c 100644 --- a/src/VahterBanBot.Tests/ContainerTestBase.fs +++ b/src/VahterBanBot.Tests/ContainerTestBase.fs @@ -9,8 +9,8 @@ open System.Threading.Tasks open DotNet.Testcontainers.Builders open DotNet.Testcontainers.Configurations open DotNet.Testcontainers.Containers +open Funogram.Telegram.Types open Npgsql -open Telegram.Bot.Types open Testcontainers.PostgreSql open VahterBanBot.Tests.TgMessageUtils open VahterBanBot.Types @@ -30,6 +30,7 @@ type VahterTestContainers() = let mutable publicConnectionString: string = null // base image for the app, we'll build exactly how we build it in Azure + let buildLogger = StringLogger() let image = ImageFromDockerfileBuilder() .WithDockerfileDirectory(solutionDir, String.Empty) @@ -39,6 +40,8 @@ type VahterTestContainers() = .WithBuildArgument("RESOURCE_REAPER_SESSION_ID", ResourceReaper.DefaultSessionId.ToString("D")) // it might speed up the process to not clean up the base image .WithCleanUp(false) + .WithDeleteIfExists(true) + .WithLogger(buildLogger) .Build() // private network for the containers @@ -113,17 +116,27 @@ type VahterTestContainers() = .DependsOn(flywayContainer) .WithWaitStrategy(Wait.ForUnixContainer().UntilPortIsAvailable(80)) .Build() + + let startContainers() = task { + try + // start building the image and spin up db at the same time + let imageTask = image.CreateAsync() + let dbTask = dbContainer.StartAsync() + + // wait for both to finish + do! imageTask + do! dbTask + with + | e -> + let logs = buildLogger.ExtractMessages() + let errorMessage = "Container startup failure, logs:\n" + if String.IsNullOrWhiteSpace logs then "" else logs + raise <| Exception(errorMessage, e) + } interface IAsyncLifetime with member this.InitializeAsync() = task { try - // start building the image and spin up db at the same time - let imageTask = image.CreateAsync() - let dbTask = dbContainer.StartAsync() - - // wait for both to finish - do! imageTask - do! dbTask + do! startContainers() publicConnectionString <- $"Server=127.0.0.1;Database=vahter_bot_ban;Port={dbContainer.GetMappedPublicPort(5432)};User Id=vahter_bot_ban_service;Password=vahter_bot_ban_service;Include Error Detail=true;Minimum Pool Size=1;Maximum Pool Size=20;Max Auto Prepare=100;Auto Prepare Min Usages=1;Trust Server Certificate=true;" // initialize DB with the schema, database and a DB user @@ -158,9 +171,10 @@ type VahterTestContainers() = httpClient.BaseAddress <- uri httpClient.DefaultRequestHeaders.Add("X-Telegram-Bot-Api-Secret-Token", "OUR_SECRET") finally - let struct (_, err) = appContainer.GetLogsAsync().Result - if err <> "" then - failwith err + if appContainer.State <> TestcontainersStates.Undefined then + let struct (_stdout, err) = appContainer.GetLogsAsync().Result + if err <> "" then + failwith err } member this.DisposeAsync() = task { // stop all the containers, flyway might be dead already @@ -246,7 +260,7 @@ WHERE data ->> 'Case' = @caseName SELECT COUNT(*) FROM false_positive_messages WHERE text = @text """ - let! result = conn.QuerySingleAsync(sql, {| text = msg.Text |}) + let! result = conn.QuerySingleAsync(sql, {| text = msg.Text.Value |}) return result > 0 } diff --git a/src/VahterBanBot.Tests/Logging.fs b/src/VahterBanBot.Tests/Logging.fs new file mode 100644 index 0000000..85c6da3 --- /dev/null +++ b/src/VahterBanBot.Tests/Logging.fs @@ -0,0 +1,16 @@ +namespace VahterBanBot.Tests + +open System +open Microsoft.Extensions.Logging + +type StringLogger() = + let lockObj = obj() + let messages = ResizeArray() + interface ILogger with + member this.BeginScope _ = null + member this.IsEnabled _ = true + member this.Log(logLevel, _eventId, state, ex, formatter) = + lock lockObj (fun() -> + messages.Add($"[{logLevel}] {formatter.Invoke(state, ex)}")) + + member _.ExtractMessages(): string = lock lockObj (fun() -> String.Join("\n", messages)) \ No newline at end of file diff --git a/src/VahterBanBot.Tests/MLBanTests.fs b/src/VahterBanBot.Tests/MLBanTests.fs index d380587..abdf5f5 100644 --- a/src/VahterBanBot.Tests/MLBanTests.fs +++ b/src/VahterBanBot.Tests/MLBanTests.fs @@ -16,7 +16,7 @@ type MLBanTests(fixture: VahterTestContainers, _unused: MlAwaitFixture) = let! _ = fixture.SendMessage msgUpdate // assert that the message got auto banned - let! msgBanned = fixture.MessageIsAutoDeleted msgUpdate.Message + let! msgBanned = fixture.MessageIsAutoDeleted msgUpdate.Message.Value Assert.True msgBanned } @@ -29,7 +29,7 @@ type MLBanTests(fixture: VahterTestContainers, _unused: MlAwaitFixture) = let! _ = fixture.SendMessage msgUpdate // assert that the message got auto banned - let! msgBanned = fixture.MessageIsAutoDeleted msgUpdate.Message + let! msgBanned = fixture.MessageIsAutoDeleted msgUpdate.Message.Value Assert.False msgBanned } @@ -42,7 +42,7 @@ type MLBanTests(fixture: VahterTestContainers, _unused: MlAwaitFixture) = let! _ = fixture.SendMessage msgUpdate // assert that the message got auto banned - let! msgBanned = fixture.MessageIsAutoDeleted msgUpdate.Message + let! msgBanned = fixture.MessageIsAutoDeleted msgUpdate.Message.Value Assert.False msgBanned } @@ -54,7 +54,7 @@ type MLBanTests(fixture: VahterTestContainers, _unused: MlAwaitFixture) = let! _ = fixture.SendMessage msgUpdate // assert that the message got auto banned - let! msgBanned = fixture.MessageIsAutoDeleted msgUpdate.Message + let! msgBanned = fixture.MessageIsAutoDeleted msgUpdate.Message.Value Assert.False msgBanned } @@ -65,7 +65,7 @@ type MLBanTests(fixture: VahterTestContainers, _unused: MlAwaitFixture) = let! _ = fixture.SendMessage msgUpdate // assert that the message got auto banned - let! msgBanned = fixture.MessageIsAutoDeleted msgUpdate.Message + let! msgBanned = fixture.MessageIsAutoDeleted msgUpdate.Message.Value Assert.False msgBanned } @@ -76,7 +76,7 @@ type MLBanTests(fixture: VahterTestContainers, _unused: MlAwaitFixture) = let! _ = fixture.SendMessage msgUpdate // assert that the message got auto banned - let! msgBanned = fixture.MessageIsAutoDeleted msgUpdate.Message + let! msgBanned = fixture.MessageIsAutoDeleted msgUpdate.Message.Value Assert.True msgBanned } @@ -88,19 +88,19 @@ type MLBanTests(fixture: VahterTestContainers, _unused: MlAwaitFixture) = let! _ = fixture.SendMessage msgUpdate // assert that the message got auto banned - let! msgBanned = fixture.MessageIsAutoDeleted msgUpdate.Message + let! msgBanned = fixture.MessageIsAutoDeleted msgUpdate.Message.Value Assert.True msgBanned // assert it is not false-positive - let! isFalsePositive = fixture.IsMessageFalsePositive msgUpdate.Message + let! isFalsePositive = fixture.IsMessageFalsePositive msgUpdate.Message.Value Assert.False isFalsePositive // send a callback to mark it as false-positive - let! callbackId = fixture.GetCallbackId msgUpdate.Message "NotASpam" + let! callbackId = fixture.GetCallbackId msgUpdate.Message.Value "NotASpam" let msgCallback = Tg.callback(string callbackId, from = fixture.Vahters[0]) let! _ = fixture.SendMessage msgCallback // assert it is false-positive - let! isFalsePositive = fixture.IsMessageFalsePositive msgUpdate.Message + let! isFalsePositive = fixture.IsMessageFalsePositive msgUpdate.Message.Value Assert.True isFalsePositive } @@ -112,17 +112,17 @@ type MLBanTests(fixture: VahterTestContainers, _unused: MlAwaitFixture) = let! _ = fixture.SendMessage msgUpdate // assert that the message got auto banned - let! msgBanned = fixture.MessageIsAutoDeleted msgUpdate.Message + let! msgBanned = fixture.MessageIsAutoDeleted msgUpdate.Message.Value Assert.True msgBanned // send a callback to mark it as false-positive // we are sending this as a usual user - let! callbackId = fixture.GetCallbackId msgUpdate.Message (nameof CallbackMessage.NotASpam) - let msgCallback = Tg.callback(string callbackId, from = msgUpdate.Message.From) + let! callbackId = fixture.GetCallbackId msgUpdate.Message.Value (nameof CallbackMessage.NotASpam) + let msgCallback = Tg.callback(string callbackId, from = msgUpdate.Message.Value.From.Value) let! _ = fixture.SendMessage msgCallback // assert it is still NOT a false-positive - let! isFalsePositive = fixture.IsMessageFalsePositive msgUpdate.Message + let! isFalsePositive = fixture.IsMessageFalsePositive msgUpdate.Message.Value Assert.False isFalsePositive } @@ -135,22 +135,22 @@ type MLBanTests(fixture: VahterTestContainers, _unused: MlAwaitFixture) = // 1 - no ban let! _ = fixture.SendMessage msgUpdate - let! msgBanned = fixture.MessageBanned msgUpdate.Message + let! msgBanned = fixture.MessageBanned msgUpdate.Message.Value Assert.False msgBanned // 2 - no ban let! _ = fixture.SendMessage msgUpdate - let! msgBanned = fixture.MessageBanned msgUpdate.Message + let! msgBanned = fixture.MessageBanned msgUpdate.Message.Value Assert.False msgBanned // 3 - no ban let! _ = fixture.SendMessage msgUpdate - let! msgBanned = fixture.MessageBanned msgUpdate.Message + let! msgBanned = fixture.MessageBanned msgUpdate.Message.Value Assert.False msgBanned // 4 - ban (depends on the ML_SPAM_AUTOBAN_SCORE_THRESHOLD) let! _ = fixture.SendMessage msgUpdate - let! msgBanned = fixture.MessageBanned msgUpdate.Message + let! msgBanned = fixture.MessageBanned msgUpdate.Message.Value Assert.True msgBanned } @@ -164,27 +164,27 @@ type MLBanTests(fixture: VahterTestContainers, _unused: MlAwaitFixture) = // 1 - no ban let! _ = fixture.SendMessage spam - let! msgBanned = fixture.MessageBanned spam.Message + let! msgBanned = fixture.MessageBanned spam.Message.Value Assert.False msgBanned // 1.5 - no ban let! _ = fixture.SendMessage notSpam - let! msgBanned = fixture.MessageBanned notSpam.Message + let! msgBanned = fixture.MessageBanned notSpam.Message.Value Assert.False msgBanned // 2 - no ban let! _ = fixture.SendMessage spam - let! msgBanned = fixture.MessageBanned spam.Message + let! msgBanned = fixture.MessageBanned spam.Message.Value Assert.False msgBanned // 3 - no ban let! _ = fixture.SendMessage spam - let! msgBanned = fixture.MessageBanned spam.Message + let! msgBanned = fixture.MessageBanned spam.Message.Value Assert.False msgBanned // 4 - no ban (as user posted 1 good message in beetween) let! _ = fixture.SendMessage spam - let! msgBanned = fixture.MessageBanned spam.Message + let! msgBanned = fixture.MessageBanned spam.Message.Value Assert.False msgBanned } @@ -197,30 +197,30 @@ type MLBanTests(fixture: VahterTestContainers, _unused: MlAwaitFixture) = // 1 - no ban let! _ = fixture.SendMessage spam - let! msgBanned = fixture.MessageBanned spam.Message - let! msgDeleted = fixture.MessageIsAutoDeleted spam.Message + let! msgBanned = fixture.MessageBanned spam.Message.Value + let! msgDeleted = fixture.MessageIsAutoDeleted spam.Message.Value Assert.True msgDeleted Assert.False msgBanned // 1.5 - vahter marked as false-positive via button // send a callback to mark it as false-positive - let! callbackId = fixture.GetCallbackId spam.Message "NotASpam" + let! callbackId = fixture.GetCallbackId spam.Message.Value "NotASpam" let msgCallback = Tg.callback(string callbackId, from = fixture.Vahters[0]) let! _ = fixture.SendMessage msgCallback // 2 - no ban let! _ = fixture.SendMessage spam - let! msgBanned = fixture.MessageBanned spam.Message + let! msgBanned = fixture.MessageBanned spam.Message.Value Assert.False msgBanned // 3 - no ban let! _ = fixture.SendMessage spam - let! msgBanned = fixture.MessageBanned spam.Message + let! msgBanned = fixture.MessageBanned spam.Message.Value Assert.False msgBanned // 4 - no ban (as vahter marked this as false positive) let! _ = fixture.SendMessage spam - let! msgBanned = fixture.MessageBanned spam.Message + let! msgBanned = fixture.MessageBanned spam.Message.Value Assert.False msgBanned } @@ -233,7 +233,7 @@ type MLBanTests(fixture: VahterTestContainers, _unused: MlAwaitFixture) = let! _ = fixture.SendMessage msgUpdate // assert that the message got auto banned - let! msgBanned = fixture.MessageIsAutoDeleted msgUpdate.Message + let! msgBanned = fixture.MessageIsAutoDeleted msgUpdate.Message.Value Assert.True msgBanned } @@ -245,7 +245,7 @@ type MLBanTests(fixture: VahterTestContainers, _unused: MlAwaitFixture) = let! _ = fixture.SendMessage msgUpdate // assert that the message got auto banned - let! msgBanned = fixture.MessageIsAutoDeleted msgUpdate.Message + let! msgBanned = fixture.MessageIsAutoDeleted msgUpdate.Message.Value Assert.True msgBanned } diff --git a/src/VahterBanBot.Tests/MessageTests.fs b/src/VahterBanBot.Tests/MessageTests.fs index b85fc08..716829c 100644 --- a/src/VahterBanBot.Tests/MessageTests.fs +++ b/src/VahterBanBot.Tests/MessageTests.fs @@ -1,10 +1,9 @@ module VahterBanBot.Tests.MessageTests open System -open System.Net +open Funogram.Telegram.Types open VahterBanBot.Types -open Telegram.Bot.Types -open Telegram.Bot.Types.Enums +open VahterBanBot.Utils open VahterBanBot.Tests.ContainerTestBase open VahterBanBot.Tests.TgMessageUtils open Xunit @@ -16,23 +15,27 @@ type MessageTests(fixture: VahterTestContainers) = let ``All data from the message being saved`` () = task { // record just a message with some additional data let msgUpdate = Tg.quickMsg(chat = fixture.ChatsToMonitor[0]) - msgUpdate.Message.Entities <- [| MessageEntity(Type = MessageEntityType.Code, Offset = 0, Length = 6) |] - msgUpdate.Message.Sticker <- Sticker(Type = StickerType.Mask, Width = 512, Height = 512, FileId = "sticker-id", FileUniqueId = "sticker-uid") + let message = msgUpdate.Message.Value + let msgUpdate = { msgUpdate with Message = Some { message with + Entities = Some [| MessageEntity.Create(``type`` = "code", offset = 0, length = 6) |] + Sticker = Some <| Sticker.Create(``type`` = "mask", width = 512, height = 512, fileId = "sticker-id", fileUniqueId = "sticker-uid", + isAnimated = false, + isVideo = false) } + } let! _ = fixture.SendMessage msgUpdate // assert that the message got recorded correctly - let! dbMsg = fixture.TryGetDbMessage msgUpdate.Message + let! dbMsg = fixture.TryGetDbMessage message Assert.True dbMsg.IsSome - let msg = msgUpdate.Message - let date = DateTimeOffset(msg.Date).ToUnixTimeSeconds() + let date = DateTimeOffset(message.Date).ToUnixTimeSeconds() Assert.Equal( - { chat_id = msgUpdate.Message.Chat.Id - message_id = msgUpdate.Message.MessageId - user_id = msgUpdate.Message.From.Id - text = msgUpdate.Message.Text - raw_message = $"""{{"chat": {{"id": -666, "type": "supergroup", "is_forum": false, "username": "pro.hell"}}, "date": {date}, "from": {{"id": {msg.From.Id}, "is_bot": false, "first_name": "{msg.From.FirstName}", "is_premium": false, "can_join_groups": false, "has_main_web_app": false, "can_connect_to_business": false, "supports_inline_queries": false, "added_to_attachment_menu": false, "can_read_all_group_messages": false}}, "text": "{msg.Text}", "sticker": {{"type": "mask", "width": 512, "height": 512, "file_id": "sticker-id", "is_video": false, "is_animated": false, "file_unique_id": "sticker-uid", "needs_repainting": false}}, "entities": [{{"type": "code", "length": 6, "offset": 0}}], "message_id": {msg.MessageId}, "is_from_offline": false, "is_topic_message": false, "has_media_spoiler": false, "is_automatic_forward": false, "has_protected_content": false, "show_caption_above_media": false}}""" + { chat_id = message.Chat.Id + message_id = message.MessageId32 + user_id = message.FromId + text = message.TextOrEmpty + raw_message = $"""{{"chat": {{"id": -666, "type": "supergroup", "username": "pro.hell"}}, "date": {date}, "from": {{"id": {message.FromId}, "is_bot": false, "first_name": "{message.FromFirstName}"}}, "text": "{message.TextOrEmpty}", "sticker": {{"type": "mask", "width": 512, "height": 512, "file_id": "sticker-id", "is_video": false, "is_animated": false, "file_unique_id": "sticker-uid"}}, "entities": [{{"type": "code", "length": 6, "offset": 0}}], "message_id": {message.MessageId}}}""" created_at = dbMsg.Value.created_at }, dbMsg.Value ) diff --git a/src/VahterBanBot.Tests/PingTests.fs b/src/VahterBanBot.Tests/PingTests.fs index 4456e0e..40fac5b 100644 --- a/src/VahterBanBot.Tests/PingTests.fs +++ b/src/VahterBanBot.Tests/PingTests.fs @@ -13,7 +13,7 @@ type PingTests(fixture: VahterTestContainers) = let msg = Tg.quickMsg(chat = fixture.ChatsToMonitor[0]) // assert that the message is not in the db - let! dbMsg = fixture.TryGetDbMessage msg.Message + let! dbMsg = fixture.TryGetDbMessage msg.Message.Value Assert.False dbMsg.IsSome // send the message to the bot @@ -21,7 +21,7 @@ type PingTests(fixture: VahterTestContainers) = Assert.Equal(HttpStatusCode.OK, resp.StatusCode) // assert that the message is in the db - let! dbMsg = fixture.TryGetDbMessage msg.Message + let! dbMsg = fixture.TryGetDbMessage msg.Message.Value Assert.True dbMsg.IsSome } @@ -31,7 +31,7 @@ type PingTests(fixture: VahterTestContainers) = let msg = Tg.quickMsg(chat = Tg.chat()) // assert that the message is not in the db - let! dbMsg = fixture.TryGetDbMessage msg.Message + let! dbMsg = fixture.TryGetDbMessage msg.Message.Value Assert.False dbMsg.IsSome // send the message to the bot @@ -39,7 +39,7 @@ type PingTests(fixture: VahterTestContainers) = Assert.Equal(HttpStatusCode.OK, resp.StatusCode) // assert that the message is still not in the db - let! dbMsg = fixture.TryGetDbMessage msg.Message + let! dbMsg = fixture.TryGetDbMessage msg.Message.Value Assert.False dbMsg.IsSome } diff --git a/src/VahterBanBot.Tests/TgMessageUtils.fs b/src/VahterBanBot.Tests/TgMessageUtils.fs index 80d43b3..9141e5f 100644 --- a/src/VahterBanBot.Tests/TgMessageUtils.fs +++ b/src/VahterBanBot.Tests/TgMessageUtils.fs @@ -2,77 +2,74 @@ module VahterBanBot.Tests.TgMessageUtils open System open System.Threading -open Telegram.Bot.Types -open Telegram.Bot.Types.Enums +open Funogram.Telegram.Types type Tg() = static let mutable i = 1L // higher than the data in the test_seed.sql static let nextInt64() = Interlocked.Increment &i static let next() = nextInt64() |> int static member user (?id: int64, ?username: string, ?firstName: string) = - User( - Id = (id |> Option.defaultValue (nextInt64())), - Username = (username |> Option.defaultValue null), - FirstName = (firstName |> Option.defaultWith (fun () -> Guid.NewGuid().ToString())) + User.Create( + id = (id |> Option.defaultValue (nextInt64())), + isBot = false, + username = (username |> Option.defaultValue null), + firstName = (firstName |> Option.defaultWith (fun () -> Guid.NewGuid().ToString())) ) static member chat (?id: int64, ?username: string) = - Chat( - Id = (id |> Option.defaultValue (nextInt64())), - Username = (username |> Option.defaultValue null), - Type = ChatType.Supergroup + Chat.Create( + id = (id |> Option.defaultValue (nextInt64())), + username = (username |> Option.defaultValue null), + ``type`` = ChatType.SuperGroup ) static member callback(data: string, ?from: User) = - Update( - Id = next(), - Message = null, - CallbackQuery = CallbackQuery( - Id = Guid.NewGuid().ToString(), - Data = data, - From = (from |> Option.defaultValue (Tg.user())), - ChatInstance = Guid.NewGuid().ToString() + Update.Create( + updateId = next(), + callbackQuery = CallbackQuery.Create( + id = Guid.NewGuid().ToString(), + data = data, + from = (from |> Option.defaultValue (Tg.user())), + chatInstance = Guid.NewGuid().ToString() ) ) static member quickMsg (?text: string, ?chat: Chat, ?from: User, ?date: DateTime, ?callback: CallbackQuery, ?caption: string, ?editedText: string) = let updateId = next() let msgId = next() - Update( - Id = updateId, - Message = - Message( - MessageId = msgId, - Text = (text |> Option.defaultValue (Guid.NewGuid().ToString())), - Chat = (chat |> Option.defaultValue (Tg.chat())), - From = (from |> Option.defaultValue (Tg.user())), - Date = (date |> Option.defaultValue DateTime.UtcNow), - Caption = (caption |> Option.defaultValue null), - ReplyToMessage = null - ), - EditedMessage = - if editedText |> Option.isSome then - Message( - MessageId = msgId, - Text = editedText.Value, - Chat = (chat |> Option.defaultValue (Tg.chat())), - From = (from |> Option.defaultValue (Tg.user())), - Date = (date |> Option.defaultValue DateTime.UtcNow), - Caption = (caption |> Option.defaultValue null), - ReplyToMessage = null + Update.Create( + updateId, + message = Message.Create( + messageId = msgId, + text = (text |> Option.defaultValue (Guid.NewGuid().ToString())), + chat = (chat |> Option.defaultValue (Tg.chat())), + from = (from |> Option.defaultValue (Tg.user())), + date = (date |> Option.defaultValue DateTime.UtcNow), + caption = (caption |> Option.defaultValue null) + ), + ?editedMessage = ( + editedText |> Option.map (fun editedText -> + Message.Create( + messageId = msgId, + text = editedText, + chat = (chat |> Option.defaultValue (Tg.chat())), + from = (from |> Option.defaultValue (Tg.user())), + date = (date |> Option.defaultValue DateTime.UtcNow), + caption = (caption |> Option.defaultValue null) ) - else null + ) ) + ) static member replyMsg (msg: Message, ?text: string, ?from: User, ?date: DateTime) = - Update( - Id = next(), - Message = - Message( - MessageId = next(), - Text = (text |> Option.defaultValue (Guid.NewGuid().ToString())), - Chat = msg.Chat, - From = (from |> Option.defaultValue (Tg.user())), - Date = (date |> Option.defaultValue DateTime.UtcNow), - ReplyToMessage = msg + Update.Create( + updateId = next(), + message = + Message.Create( + messageId = next(), + text = (text |> Option.defaultValue (Guid.NewGuid().ToString())), + chat = msg.Chat, + from = (from |> Option.defaultValue (Tg.user())), + date = (date |> Option.defaultValue DateTime.UtcNow), + replyToMessage = msg ) ) diff --git a/src/VahterBanBot.Tests/VahterBanBot.Tests.fsproj b/src/VahterBanBot.Tests/VahterBanBot.Tests.fsproj index ffa6474..9ed5220 100644 --- a/src/VahterBanBot.Tests/VahterBanBot.Tests.fsproj +++ b/src/VahterBanBot.Tests/VahterBanBot.Tests.fsproj @@ -11,6 +11,7 @@ + diff --git a/src/VahterBanBot/Bot.fs b/src/VahterBanBot/Bot.fs index f397b85..684a898 100644 --- a/src/VahterBanBot/Bot.fs +++ b/src/VahterBanBot/Bot.fs @@ -4,10 +4,8 @@ open System open System.Diagnostics open System.Text open System.Threading.Tasks +open Funogram.Telegram.Types open Microsoft.Extensions.Logging -open Telegram.Bot -open Telegram.Bot.Types -open Telegram.Bot.Types.ReplyMarkups open VahterBanBot.ML open VahterBanBot.Types open VahterBanBot.Utils @@ -16,29 +14,29 @@ open VahterBanBot.UpdateChatAdmins let botActivity = new ActivitySource("VahterBanBot") let isChannelMessage (message: Message) = - message.From.IsBot && - message.From.FirstName = "Channel" && - message.From.Username = "Channel_Bot" + message.IsFromBot && + message.FromFirstName = "Channel" && + message.FromUsername = "Channel_Bot" let isPingCommand (message: Message) = - message.Text = "/ban ping" + message.TextOrEmpty = "/ban ping" let isBanCommand (message: Message) = - message.Text = "/ban" + message.TextOrEmpty = "/ban" let isUnbanCommand (message: Message) = - message.Text.StartsWith "/unban " + message.TextOrEmpty.StartsWith "/unban " let isSoftBanCommand (message: Message) = - message.Text.StartsWith "/sban" + message.TextOrEmpty.StartsWith "/sban" let isSoftBanOnReplyCommand (message: Message) = isSoftBanCommand message && - message.ReplyToMessage <> null + Option.isSome message.ReplyToMessage let isBanOnReplyCommand (message: Message) = isBanCommand message && - message.ReplyToMessage <> null + Option.isSome message.ReplyToMessage let isMessageFromAllowedChats (botConfig: BotConfiguration) (message: Message) = botConfig.ChatsToMonitor.ContainsValue message.Chat.Id @@ -47,10 +45,10 @@ let isUserVahter (botConfig: BotConfiguration) (user: DbUser) = botConfig.AllowedUsers.ContainsValue user.id let isBannedPersonAdmin (botConfig: BotConfiguration) (message: Message) = - botConfig.AllowedUsers.ContainsValue message.From.Id + botConfig.AllowedUsers.ContainsValue message.FromId let isKnownCommand (message: Message) = - message.Text <> null && + Option.isSome message.Text && (isPingCommand message || isBanCommand message || isUnbanCommand message || @@ -65,8 +63,8 @@ let isBanAuthorized let fromUsername = defaultArg vahter.username null let chatId = bannedMessage.Chat.Id let chatUsername = bannedMessage.Chat.Username - let targetUserId = bannedMessage.From.Id - let targetUsername = bannedMessage.From.Username + let targetUserId = bannedMessage.FromId + let targetUsername = bannedMessage.FromUsername // check that user is allowed to ban others if isUserVahter botConfig vahter then @@ -83,13 +81,13 @@ let isBanAuthorized logger.LogWarning $"User {fromUsername} ({fromUserId}) tried to ban user {prependUsername targetUsername} ({targetUserId}) without being admin in chat {chatUsername} ({chatId}" false -let banInAllChats (botConfig: BotConfiguration) (botClient: ITelegramBotClient) targetUserId = task { +let banInAllChats (botConfig: BotConfiguration) (botClient: TelegramBotClient) targetUserId = task { let banTasks = botConfig.ChatsToMonitor |> Seq.map (fun (KeyValue(chatUserName, chatId)) -> task { // ban user in each chat try - do! botClient.BanChatMemberAsync(ChatId chatId, targetUserId, DateTime.UtcNow.AddMonths 13) + let! _ = botClient.BanChatMemberAsync(ChatId.Int chatId, targetUserId, DateTimeOffset.UtcNow.AddMonths 13) return Ok(chatUserName, chatId) with e -> return Error (chatUserName, chatId, e) @@ -97,38 +95,38 @@ let banInAllChats (botConfig: BotConfiguration) (botClient: ITelegramBotClient) return! Task.WhenAll banTasks } -let softBanInChat (botClient: ITelegramBotClient) (chatId: ChatId) targetUserId (duration: int) = task { - let permissions = ChatPermissions( - CanSendMessages = false, - CanSendAudios = false, - CanSendDocuments = false, - CanSendPhotos = false, - CanSendVideos = false, - CanSendVideoNotes = false, - CanSendVoiceNotes = false, - CanSendPolls = false, - CanSendOtherMessages = false, - CanAddWebPagePreviews = false, - CanChangeInfo = false, - CanInviteUsers = false, - CanPinMessages = false, - CanManageTopics = false +let softBanInChat (botClient: TelegramBotClient) (chatId: ChatId) targetUserId (duration: int) = task { + let permissions = ChatPermissions.Create( + canSendMessages = false, + canSendAudios = false, + canSendDocuments = false, + canSendPhotos = false, + canSendVideos = false, + canSendVideoNotes = false, + canSendVoiceNotes = false, + canSendPolls = false, + canSendOtherMessages = false, + canAddWebPagePreviews = false, + canChangeInfo = false, + canInviteUsers = false, + canPinMessages = false, + canManageTopics = false ) let untilDate = DateTime.UtcNow.AddHours duration try - do! botClient.RestrictChatMemberAsync(chatId, targetUserId, permissions, untilDate = untilDate) + let! _ = botClient.RestrictChatMemberAsync(chatId, targetUserId, permissions, untilDate = untilDate) return Ok(chatId, targetUserId) with e -> return Error(chatId, targetUserId, e) } -let unbanInAllChats (botConfig: BotConfiguration) (botClient: ITelegramBotClient) targetUserId = task { +let unbanInAllChats (botConfig: BotConfiguration) (botClient: TelegramBotClient) targetUserId = task { let unbanTasks = botConfig.ChatsToMonitor |> Seq.map (fun (KeyValue(chatUserName, chatId)) -> task { // unban user in each chat try - do! botClient.UnbanChatMemberAsync(ChatId chatId, targetUserId, true) + let! _ = botClient.UnbanChatMemberAsync(ChatId.Int chatId, targetUserId) return Ok(chatUserName, chatId) with e -> return Error (chatUserName, chatId, e) @@ -162,7 +160,7 @@ let aggregateResultInLogMsg let chatId = chat.Id let logMsgBuilder = StringBuilder() - %logMsgBuilder.Append($"Vahter {prependUsername vahterUsername}({vahterUserId}) {resultType}ned {sanitizedUsername} ({targetUserId}) in {prependUsername chatName}({chatId})") + %logMsgBuilder.Append($"Vahter {prependUsername vahterUsername}({vahterUserId}) {resultType}ned {sanitizedUsername} ({targetUserId}) in {prependUsernameO chatName}({chatId})") // we don't want to spam logs channel if all is good let allChatsOk = results |> Array.forall Result.isOk @@ -205,38 +203,37 @@ let softBanResultInLogMsg (message: Message) (vahter: DbUser) (duration: int) = let vahterUsername = defaultArg vahter.username null let untilDate = (DateTime.UtcNow.AddHours duration).ToString "u" %logMsgBuilder.Append $"Vahter {prependUsername vahterUsername}({vahter.id}) " - %logMsgBuilder.Append $"softbanned {prependUsername message.From.Username}({message.From.Id}) " - %logMsgBuilder.Append $"in {prependUsername message.Chat.Username}({message.Chat.Id}) " + %logMsgBuilder.Append $"softbanned {prependUsername message.FromUsername}({message.FromId}) " + %logMsgBuilder.Append $"in {prependUsernameO message.Chat.Username}({message.Chat.Id}) " %logMsgBuilder.Append $"until {untilDate}" string logMsgBuilder let ping - (botClient: ITelegramBotClient) + (botClient: TelegramBotClient) (message: Message) = task { use _ = botActivity.StartActivity("ping") - do! botClient.SendTextMessageAsync(ChatId(message.Chat.Id), "pong") |> taskIgnore + do! botClient.SendTextMessageAsync(ChatId.Int(message.Chat.Id), "pong") |> taskIgnore } let deleteChannelMessage - (botClient: ITelegramBotClient) + (botClient: TelegramBotClient) (message: Message) (logger: ILogger) = task { use banOnReplyActivity = botActivity.StartActivity("deleteChannelMessage") - do! botClient.DeleteMessageAsync(ChatId(message.Chat.Id), message.MessageId) + do! botClient.DeleteMessageAsync(ChatId.Int(message.Chat.Id), message.MessageId) |> safeTaskAwait (fun e -> logger.LogError ($"Failed to delete message {message.MessageId} from chat {message.Chat.Id}", e)) let probablyChannelName = - if message.SenderChat <> null then - message.SenderChat.Title - else - "[unknown]" + message.SenderChat + |> Option.bind _.Title + |> Option.defaultValue "[unknown]" %banOnReplyActivity.SetTag("channelName", probablyChannelName) logger.LogInformation $"Deleted message from channel {probablyChannelName}" } let totalBan - (botClient: ITelegramBotClient) + (botClient: TelegramBotClient) (botConfig: BotConfiguration) (message: Message) (vahter: DbUser) @@ -245,8 +242,8 @@ let totalBan %banOnReplyActivity .SetTag("vahterId", vahter.id) .SetTag("vahterUsername", (defaultArg vahter.username null)) - .SetTag("targetId", message.From.Id) - .SetTag("targetUsername", message.From.Username) + .SetTag("targetId", message.FromId) + .SetTag("targetUsername", message.FromUsername) // delete message let deleteMsgTask = task { @@ -256,18 +253,22 @@ let totalBan .SetTag("msgId", message.MessageId) .SetTag("chatId", message.Chat.Id) .SetTag("chatUsername", message.Chat.Username) - do! botClient.DeleteMessageAsync(ChatId(message.Chat.Id), message.MessageId) + do! botClient.DeleteMessageAsync(ChatId.Int(message.Chat.Id), message.MessageId) |> safeTaskAwait (fun e -> logger.LogError ($"Failed to delete message {message.MessageId} from chat {message.Chat.Id}", e)) } + + match message.From with + | None -> () + | Some user -> // update user in DB let! updatedUser = - message.From + user |> DbUser.newUser |> DB.upsertUser let deletedUserMessagesTask = task { - let fromUserId = message.From.Id + let fromUserId = message.FromId let! allUserMessages = DB.getUserMessages fromUserId logger.LogInformation($"Deleting {allUserMessages.Length} messages from user {fromUserId}") @@ -281,7 +282,8 @@ let totalBan .StartActivity("deleteMsg") .SetTag("msgId", msg.message_id) .SetTag("chatId", msg.chat_id) - do! botClient.DeleteMessageAsync(ChatId(msg.chat_id), msg.message_id) + let! _ = botClient.DeleteMessageAsync(ChatId.Int(msg.chat_id), msg.message_id) + () with e -> logger.LogError ($"Failed to delete message {msg.message_id} from chat {msg.chat_id}", e) }) @@ -292,7 +294,7 @@ let totalBan } // try ban user in all monitored chats - let! banResults = banInAllChats botConfig botClient message.From.Id + let! banResults = banInAllChats botConfig botClient message.FromId let! deletedUserMessages = deletedUserMessagesTask // produce aggregated log message @@ -304,47 +306,58 @@ let totalBan |> DB.banUser // log both to logger and to logs channel - do! botClient.SendTextMessageAsync(ChatId(botConfig.LogsChannelId), logMsg) |> taskIgnore + let! _ = botClient.SendTextMessageAsync(ChatId.Int(botConfig.LogsChannelId), logMsg) |> taskIgnore logger.LogInformation logMsg do! deleteMsgTask } let banOnReply - (botClient: ITelegramBotClient) + (botClient: TelegramBotClient) (botConfig: BotConfiguration) (message: Message) (vahter: DbUser) (logger: ILogger) = task { + match message.ReplyToMessage with + | None -> () + | Some replyToMessage -> + + match replyToMessage.From with + | None -> () + | Some target -> + use banOnReplyActivity = botActivity.StartActivity("banOnReply") + %banOnReplyActivity - .SetTag("vahterId", message.From.Id) - .SetTag("vahterUsername", message.From.Username) - .SetTag("targetId", message.ReplyToMessage.From.Id) - .SetTag("targetUsername", message.ReplyToMessage.From.Username) + .SetTag("vahterId", message.FromId) + .SetTag("vahterUsername", message.FromUsername) + .SetTag("targetId", target.Id) + .SetTag("targetUsername", target.Username |> Option.toObj) do! totalBan botClient botConfig - message.ReplyToMessage + replyToMessage vahter logger } let softBanMsg - (botClient: ITelegramBotClient) + (botClient: TelegramBotClient) (botConfig: BotConfiguration) (commandMessage: Message) (vahter: DbUser) (logger: ILogger) = task { - let messageToRemove = commandMessage.ReplyToMessage + match commandMessage.ReplyToMessage with + | None -> () + | Some messageToRemove -> use banOnReplyActivity = botActivity.StartActivity("softBanOnReply") %banOnReplyActivity .SetTag("vahterId", vahter.id) .SetTag("vahterUsername", defaultArg vahter.username null) - .SetTag("targetId", messageToRemove.From.Id) - .SetTag("targetUsername", messageToRemove.From.Username) + .SetTag("targetId", messageToRemove.FromId) + .SetTag("targetUsername", messageToRemove.FromUsername) let deleteMsgTask = task { use _ = @@ -353,11 +366,11 @@ let softBanMsg .SetTag("msgId", messageToRemove.MessageId) .SetTag("chatId", messageToRemove.Chat.Id) .SetTag("chatUsername", messageToRemove.Chat.Username) - do! botClient.DeleteMessageAsync(ChatId(messageToRemove.Chat.Id), messageToRemove.MessageId) + do! botClient.DeleteMessageAsync(ChatId.Int(messageToRemove.Chat.Id), messageToRemove.MessageId) |> safeTaskAwait (fun e -> logger.LogError ($"Failed to delete reply message {messageToRemove.MessageId} from chat {messageToRemove.Chat.Id}", e)) } - let maybeDurationString = commandMessage.Text.Split " " |> Seq.last + let maybeDurationString = commandMessage.TextOrEmpty.Split " " |> Seq.last // use last value as soft ban duration let duration = match Int32.TryParse maybeDurationString with @@ -366,15 +379,15 @@ let softBanMsg let logText = softBanResultInLogMsg messageToRemove vahter duration - do! softBanInChat botClient (ChatId messageToRemove.Chat.Id) messageToRemove.From.Id duration |> taskIgnore + do! softBanInChat botClient (ChatId.Int messageToRemove.Chat.Id) messageToRemove.FromId duration |> taskIgnore do! deleteMsgTask - do! botClient.SendTextMessageAsync(ChatId(botConfig.LogsChannelId), logText) |> taskIgnore + do! botClient.SendTextMessageAsync(ChatId.Int(botConfig.LogsChannelId), logText) |> taskIgnore logger.LogInformation logText } let unban - (botClient: ITelegramBotClient) + (botClient: TelegramBotClient) (botConfig: BotConfiguration) (message: Message) (vahter: DbUser) @@ -399,12 +412,12 @@ let unban let logMsg = aggregateUnbanResultInLogMsg message.Chat vahter userToUnban logger 0 unbanResults // log both to logger and to logs channel - do! botClient.SendTextMessageAsync(ChatId(botConfig.LogsChannelId), logMsg) |> taskIgnore + do! botClient.SendTextMessageAsync(ChatId.Int(botConfig.LogsChannelId), logMsg) |> taskIgnore logger.LogInformation logMsg } let killSpammerAutomated - (botClient: ITelegramBotClient) + (botClient: TelegramBotClient) (botConfig: BotConfiguration) (message: Message) (logger: ILogger) @@ -412,52 +425,52 @@ let killSpammerAutomated score = task { use banOnReplyActivity = botActivity.StartActivity("killAutomated") %banOnReplyActivity - .SetTag("spammerId", message.From.Id) - .SetTag("spammerUsername", message.From.Username) + .SetTag("spammerId", message.FromId) + .SetTag("spammerUsername", message.FromUsername) if deleteMessage then // delete message - do! botClient.DeleteMessageAsync(ChatId(message.Chat.Id), message.MessageId) + do! botClient.DeleteMessageAsync(ChatId.Int(message.Chat.Id), message.MessageId) |> safeTaskAwait (fun e -> logger.LogError ($"Failed to delete message {message.MessageId} from chat {message.Chat.Id}", e)) // 0 here is the bot itself do! DbBanned.banMessage 0 message |> DB.banUserByBot let msgType = if deleteMessage then "Deleted" else "Detected" - let logMsg = $"{msgType} spam (score: {score}) in {prependUsername message.Chat.Username} ({message.Chat.Id}) from {prependUsername message.From.Username} ({message.From.Id}) with text:\n{message.TextOrCaption}" + let logMsg = $"{msgType} spam (score: {score}) in {prependUsernameO message.Chat.Username} ({message.Chat.Id}) from {prependUsername message.FromUsername} ({message.FromId}) with text:\n{message.TextOrCaption}" let! replyMarkup = task { if deleteMessage then let data = CallbackMessage.NotASpam { message = message } let! callback = DB.newCallback data - return InlineKeyboardMarkup [ - InlineKeyboardButton.WithCallbackData("✅ NOT a spam", string callback.id) - ] + return InlineKeyboardMarkup.Create [| + [| InlineKeyboardButton.Create(text = "✅ NOT a spam", callbackData = string callback.id) |] + |] else let spamData = CallbackMessage.Spam { message = message } let! spamCallback = DB.newCallback spamData - return InlineKeyboardMarkup [ - InlineKeyboardButton.WithCallbackData("🚫 KILL", string spamCallback.id) - ] + return InlineKeyboardMarkup.Create [| + [| InlineKeyboardButton.Create(text = "🚫 KILL", callbackData = string spamCallback.id) |] + |] } // log both to logger and to logs channel - do! botClient.SendTextMessageAsync(ChatId(botConfig.LogsChannelId), logMsg, replyMarkup = replyMarkup) |> taskIgnore + do! botClient.SendTextMessageAsync(ChatId.Int(botConfig.LogsChannelId), logMsg, replyMarkup = Markup.InlineKeyboardMarkup replyMarkup) |> taskIgnore logger.LogInformation logMsg } let autoBan (botUser: DbUser) - (botClient: ITelegramBotClient) + (botClient: TelegramBotClient) (botConfig: BotConfiguration) (message: Message) (logger: ILogger) = task { use banOnReplyActivity = botActivity.StartActivity("autoBan") %banOnReplyActivity - .SetTag("spammerId", message.From.Id) - .SetTag("spammerUsername", message.From.Username) + .SetTag("spammerId", message.FromId) + .SetTag("spammerUsername", message.FromUsername) - let! userStats = DB.getUserStatsByLastNMessages botConfig.MlSpamAutobanCheckLastMsgCount message.From.Id + let! userStats = DB.getUserStatsByLastNMessages botConfig.MlSpamAutobanCheckLastMsgCount message.FromId let socialScore = userStats.good - userStats.bad %banOnReplyActivity.SetTag("socialScore", socialScore) @@ -465,14 +478,14 @@ let autoBan if double socialScore <= botConfig.MlSpamAutobanScoreThreshold then // ban user in all monitored chats do! totalBan botClient botConfig message botUser logger - let msg = $"Auto-banned user {prependUsername message.From.Username} ({message.From.Id}) due to the low social score {socialScore}" + let msg = $"Auto-banned user {prependUsername message.FromUsername} ({message.FromId}) due to the low social score {socialScore}" logger.LogInformation msg - do! botClient.SendTextMessageAsync(ChatId(botConfig.LogsChannelId), msg) |> taskIgnore + do! botClient.SendTextMessageAsync(ChatId.Int(botConfig.LogsChannelId), msg) |> taskIgnore } let justMessage (botUser: DbUser) - (botClient: ITelegramBotClient) + (botClient: TelegramBotClient) (botConfig: BotConfiguration) (logger: ILogger) (ml: MachineLearning) @@ -481,16 +494,16 @@ let justMessage use _ = botActivity .StartActivity("justMessage") - .SetTag("fromUserId", message.From.Id) - .SetTag("fromUsername", message.From.Username) + .SetTag("fromUserId", message.FromId) + .SetTag("fromUsername", message.FromUsername) // check if user got auto-banned already // that could happen due to the race condition between spammers mass messages // and the bot's processing queue - let! isAutoBanned = DB.isBannedByVahter botUser.id message.From.Id + let! isAutoBanned = DB.isBannedByVahter botUser.id message.FromId if isAutoBanned then // just delete message and move on - do! botClient.DeleteMessageAsync(ChatId(message.Chat.Id), message.MessageId) + do! botClient.DeleteMessageAsync(ChatId.Int(message.Chat.Id), message.MessageId) |> safeTaskAwait (fun e -> logger.LogError ($"Failed to delete message {message.MessageId} from chat {message.Chat.Id}", e)) elif botConfig.MlEnabled && message.TextOrCaption <> null then @@ -498,8 +511,8 @@ let justMessage let shouldBeSkipped = // skip prediction for vahters or local admins - if botConfig.AllowedUsers.ContainsValue message.From.Id - || UpdateChatAdmins.Admins.Contains message.From.Id then + if botConfig.AllowedUsers.ContainsValue message.FromId + || UpdateChatAdmins.Admins.Contains message.FromId then true else @@ -511,7 +524,7 @@ let justMessage %mlActivity.SetTag("skipPrediction", shouldBeSkipped) if not shouldBeSkipped then - let! usrMsgCount = DB.countUniqueUserMsg message.From.Id + let! usrMsgCount = DB.countUniqueUserMsg message.FromId match ml.Predict(message.TextOrCaption, usrMsgCount) with | Some prediction -> @@ -542,18 +555,22 @@ let justMessage } let adminCommand - (botClient: ITelegramBotClient) + (botClient: TelegramBotClient) (botConfig: BotConfiguration) (logger: ILogger) (vahter: DbUser) (message: Message) = + match message.ReplyToMessage with + | None -> Task.FromResult() + | Some replyToMessage -> + // aux functions to overcome annoying FS3511: This state machine is not statically compilable. let banOnReplyAux() = task { let authed = isBanAuthorized botConfig - message.ReplyToMessage + replyToMessage vahter logger if authed then @@ -561,7 +578,7 @@ let adminCommand } let unbanAux() = task { if isUserVahter botConfig vahter then - let targetUserId = message.Text.Split(" ", StringSplitOptions.RemoveEmptyEntries)[1] |> int64 + let targetUserId = message.TextOrEmpty.Split(" ", StringSplitOptions.RemoveEmptyEntries)[1] |> int64 let! userToUnban = DB.getUserById targetUserId match userToUnban with | None -> @@ -573,7 +590,7 @@ let adminCommand let authed = isBanAuthorized botConfig - message.ReplyToMessage + replyToMessage vahter logger if authed then @@ -590,7 +607,7 @@ let adminCommand .SetTag("msgId", message.MessageId) .SetTag("chatId", message.Chat.Id) .SetTag("chatUsername", message.Chat.Username) - do! botClient.DeleteMessageAsync(ChatId(message.Chat.Id), message.MessageId) + do! botClient.DeleteMessageAsync(ChatId.Int(message.Chat.Id), message.MessageId) |> safeTaskAwait (fun e -> logger.LogError ($"Failed to delete ping message {message.MessageId} from chat {message.Chat.Id}", e)) } // check that user is allowed to (un)ban others @@ -608,17 +625,18 @@ let adminCommand let onMessage (botUser: DbUser) - (botClient: ITelegramBotClient) + (botClient: TelegramBotClient) (botConfig: BotConfiguration) (logger: ILogger) (ml: MachineLearning) (message: Message) = task { + use banOnReplyActivity = botActivity.StartActivity("onMessage") // early return if we can't process it - if isNull message || isNull message.From then - logger.LogWarning "Received update without message" - else + match message.From with + | None -> logger.LogWarning "Received update without message" + | Some from -> // early return if we don't monitor this chat if not (botConfig.ChatsToMonitor.ContainsValue message.Chat.Id) then @@ -631,7 +649,7 @@ let onMessage // upserting user to DB let! user = - DbUser.newUser message.From + DbUser.newUser from |> DB.upsertUser // check if message comes from channel, we should delete it immediately @@ -648,7 +666,7 @@ let onMessage } let vahterMarkedAsNotSpam - (botClient: ITelegramBotClient) + (botClient: TelegramBotClient) (botConfig: BotConfiguration) (logger: ILogger) (vahter: DbUser) @@ -667,13 +685,13 @@ let vahterMarkedAsNotSpam let vahterUsername = vahter.username |> Option.defaultValue null - let logMsg = $"Vahter {prependUsername vahterUsername} ({vahter.id}) marked message {msgId} in {prependUsername chatName}({chatId}) as false-positive (NOT A SPAM)\n{msg.message.TextOrCaption}" - do! botClient.SendTextMessageAsync(ChatId(botConfig.LogsChannelId), logMsg) |> taskIgnore + let logMsg = $"Vahter {prependUsername vahterUsername} ({vahter.id}) marked message {msgId} in {prependUsernameO chatName}({chatId}) as false-positive (NOT A SPAM)\n{msg.message.TextOrCaption}" + do! botClient.SendTextMessageAsync(ChatId.Int(botConfig.LogsChannelId), logMsg) |> taskIgnore logger.LogInformation logMsg } let vahterMarkedAsSpam - (botClient: ITelegramBotClient) + (botClient: TelegramBotClient) (botConfig: BotConfiguration) (logger: ILogger) (vahter: DbUser) @@ -697,14 +715,14 @@ let vahterMarkedAsSpam } let onCallback - (botClient: ITelegramBotClient) + (botClient: TelegramBotClient) (botConfig: BotConfiguration) (logger: ILogger) (callbackQuery: CallbackQuery) = task { use onCallbackActivity = botActivity.StartActivity("onCallback") %onCallbackActivity.SetTag("callbackId", callbackQuery.Data) - let callbackId = Guid.Parse callbackQuery.Data + let callbackId = Guid.Parse(callbackQuery.Data |> Option.defaultValue "") match! DB.getCallback callbackId with | None -> @@ -732,19 +750,22 @@ let onCallback %onCallbackActivity.SetTag("type", "Spam") do! vahterMarkedAsSpam botClient botConfig logger vahter msg do! DB.deleteCallback callbackId - do! botClient.AnswerCallbackQueryAsync(callbackQuery.Id) + let! _ = botClient.AnswerCallbackQueryAsync(callbackQuery.Id) + () } let onUpdate (botUser: DbUser) - (botClient: ITelegramBotClient) + (botClient: TelegramBotClient) (botConfig: BotConfiguration) (logger: ILogger) (ml: MachineLearning) (update: Update) = task { use _ = botActivity.StartActivity("onUpdate") - if update.CallbackQuery <> null then - do! onCallback botClient botConfig logger update.CallbackQuery - else - do! onMessage botUser botClient botConfig logger ml update.EditedOrMessage + match update.CallbackQuery with + | Some callbackQuery -> do! onCallback botClient botConfig logger callbackQuery + | None -> + match update.EditedOrMessage with + | None -> () + | Some editedOrMessage -> do! onMessage botUser botClient botConfig logger ml editedOrMessage } diff --git a/src/VahterBanBot/Cleanup.fs b/src/VahterBanBot/Cleanup.fs index 5087161..75002fb 100644 --- a/src/VahterBanBot/Cleanup.fs +++ b/src/VahterBanBot/Cleanup.fs @@ -2,9 +2,8 @@ open System.Text open System.Threading.Tasks +open Funogram.Telegram.Types open Microsoft.Extensions.Logging -open Telegram.Bot -open Telegram.Bot.Types open VahterBanBot.Types open VahterBanBot.Utils open System @@ -13,7 +12,7 @@ open Microsoft.Extensions.Hosting type CleanupService( logger: ILogger, - telegramClient: ITelegramBotClient, + telegramClient: TelegramBotClient, botConf: BotConfiguration ) = let mutable timer: Timer = null @@ -31,7 +30,7 @@ type CleanupService( let msg = sb.ToString() do! telegramClient.SendTextMessageAsync( - ChatId(botConf.LogsChannelId), + ChatId.Int(botConf.LogsChannelId), msg ) |> taskIgnore logger.LogInformation msg diff --git a/src/VahterBanBot/Converters.fs b/src/VahterBanBot/Converters.fs new file mode 100644 index 0000000..4382737 --- /dev/null +++ b/src/VahterBanBot/Converters.fs @@ -0,0 +1,252 @@ +// SPDX-FileCopyrightText: Copyright (c) 2017 Nikolay Matyushin +// +// SPDX-License-Identifier: MIT + +namespace Funogram + +open System +open System.Collections.Generic +open System.IO +open System.Text.Json +open System.Text.Json.Serialization +open TypeShape.Core +open TypeShape.Core.SubtypeExtensions + +module internal Converters = + open Funogram.StringUtils + + let private unixEpoch = DateTime(1970, 1, 1, 0, 0, 0, DateTimeKind.Utc) + let toUnix (x: DateTime) = (x.ToUniversalTime() - unixEpoch).TotalSeconds |> int64 + + let mkMemberSerializer (case: ShapeFSharpUnionCase<'DeclaringType>) = + let isFile = + case.Fields.Length = 2 + && case.Fields[0].Member.Type = typeof + && (case.Fields[1].Member.Type = typeof || case.Fields[1].Member.Type = typeof) + + if case.Fields.Length = 0 then + let name = caseName case.CaseInfo + fun (writer: Utf8JsonWriter) _ _ -> + writer.WriteStringValue(name) + else + case.Fields[0].Accept { new IMemberVisitor<'DeclaringType, Utf8JsonWriter -> 'DeclaringType -> JsonSerializerOptions -> unit> with + member _.Visit (shape : ShapeMember<'DeclaringType, 'Field>) = + fun writer value options -> + if isFile then + let str = box (shape.Get value) |> unbox + writer.WriteStringValue($"attach://{str}") + else + let v = shape.Get value + let converter = options.GetConverter(v.GetType()) + let c = converter :?> JsonConverter<'a> + c.Write(writer, v, options) + } + + [] + type IUnionDeserializer<'T> = + abstract member Deserialize: reader: byref * options: JsonSerializerOptions -> 'T + + type CaseFullDeserializer<'DeclaringType, 'Field>(shape: ShapeMember<'DeclaringType, 'Field>, init: unit -> 'DeclaringType) = + member x.Deserialize(reader: byref, options: JsonSerializerOptions) = + let converter = options.GetConverter(typeof<'DeclaringType>) :?> JsonConverter<'Field> + converter.Read(&reader, typeof<'DeclaringType>, options) |> shape.Set (init ()) + + type CaseNameDeserializer<'DeclaringType>(init: unit -> 'DeclaringType) = + member x.Deserialize(reader: byref, _: JsonSerializerOptions) = + reader.Read() |> ignore + init () + + let mkMemberDeserializer (case: ShapeFSharpUnionCase<'DeclaringType>) (init: unit -> 'DeclaringType) = + if case.Fields.Length = 0 then + { new IUnionDeserializer<'DeclaringType> with + member x.Deserialize(reader, _) = + //reader.Read() |> ignore + init () + } + else + case.Fields[0].Accept { new IMemberVisitor<'DeclaringType, IUnionDeserializer<'DeclaringType>> with + member x.Visit (shape: ShapeMember<'DeclaringType, 'Field>) = + { new IUnionDeserializer<'DeclaringType> with + member x.Deserialize(reader, options) = + let converter = options.GetConverter(typeof<'Field>) + let converter = converter :?> JsonConverter<'Field> + converter.Read(&reader, typeof<'Field>, options) |> shape.Set (init ()) + } + } + + type DiscriminatedUnionConverter<'a>() = + inherit JsonConverter<'a>() + + let shape = shapeof<'a> + let union = + match shape with + | Shape.FSharpUnion (:? ShapeFSharpUnion<'a> as union) -> union + | _ -> failwith "Unsupported type" + + let enumUnion = union.UnionCases |> Seq.forall (fun x -> x.Fields.Length = 0) + + let cases = + union.UnionCases + |> Seq.map (fun c -> + if c.Fields.Length = 0 then + (Set.ofList [caseName c.CaseInfo], None) + else + let tp = c.Fields[0].Member.Type + if tp.IsPrimitive then (Set.empty, Some tp) + else (tp.GetProperties() + |> Seq.map(fun x -> x.Name |> toSnakeCase) + |> Set.ofSeq, + None)) + |> Seq.toArray + + let serializers = + union.UnionCases + |> Seq.map mkMemberSerializer + |> Seq.toArray + + let deserializers = + union.UnionCases + |> Seq.map (fun case -> mkMemberDeserializer case case.CreateUninitialized) + |> Seq.toArray + + override x.Write(writer, value, options) = + let serialize = serializers[union.GetTag value] // all union cases + serialize writer value options + + member x.ReadCasesOnly(reader: byref) = + let mutable types: Type list = [] + let caseNames = List() + + let reader = reader // copy reader + let mutable loop = true + let mutable first = true + + if reader.TokenType = JsonTokenType.StartObject then + reader.Read() |> ignore + + while loop do + let token = reader.TokenType + if first && not enumUnion then + loop <- false + types <- + match token with + | JsonTokenType.True | JsonTokenType.False -> [typeof] + | JsonTokenType.String -> [typeof] + | JsonTokenType.Number -> [typeof;typeof;typeof;typeof] + | _ -> + types + + if types.Length > 0 then + loop <- false + + first <- false + + if enumUnion then + caseNames.Add(reader.GetString()) + reader.Read() |> ignore + loop <- false + else + match token with + | JsonTokenType.PropertyName -> + caseNames.Add(reader.GetString()) + | JsonTokenType.StartObject + | JsonTokenType.StartArray -> + reader.Skip() + | _ -> () + + loop <- reader.Read() + + caseNames, types + + override x.Read(reader, _, options) = + let jsonCaseNames, jsonCaseTypes = x.ReadCasesOnly(&reader) + + let idx = + cases + |> Array.tryFindIndex (fun (caseNames, tp) -> + (jsonCaseTypes.Length = 0 || (tp.IsSome && jsonCaseTypes |> Seq.contains tp.Value)) + && jsonCaseNames |> Seq.forall (fun n -> + caseNames |> Set.contains n)) + + match idx with + | Some idx -> + deserializers[idx].Deserialize(&reader, options) + | None -> + // try to find most similar type + let item = + cases |> Array.maxBy (fun (caseNames, tp) -> + if jsonCaseTypes.Length = 0 || (tp.IsSome && jsonCaseTypes |> Seq.contains tp.Value) then + jsonCaseNames |> Seq.sumBy (fun n -> if caseNames |> Set.contains n then 1 else 0) + else + -1 + ) + + let idx = cases |> Array.findIndex (fun x -> x = item) + deserializers[idx].Deserialize(&reader, options) + + override x.CanConvert(typeToConvert) = + match TypeShape.Create(typeToConvert) with + | Shape.FSharpOption _ -> false + | Shape.FSharpUnion _ -> true + | _ -> false + + type DiscriminatedUnionConverterFactory() = + inherit JsonConverterFactory() + + override x.CreateConverter(typeToConvert, _) = + let g = typedefof>.MakeGenericType(typeToConvert) + Activator.CreateInstance(g) :?> JsonConverter + + override x.CanConvert(typeToConvert) = + match TypeShape.Create(typeToConvert) with + | Shape.FSharpOption _ -> false + | Shape.FSharpUnion _ -> true + | _ -> false + + type UnixTimestampDateTimeConverter() = + inherit JsonConverter() + let unixEpoch = DateTime(1970, 1, 1, 0, 0, 0, DateTimeKind.Utc) + + override x.Read(reader, _, _) = + let v = reader.GetInt64() |> float + unixEpoch.AddSeconds(v) + + override x.Write(writer, value, _) = + writer.WriteNumberValue(toUnix value) + + type OptionConverter<'T>() = + inherit JsonConverter>() + + override x.Read(reader, _, options) = + match reader.TokenType with + | JsonTokenType.Null -> + None + | _ -> + let converter = options.GetConverter(typeof<'T>) + let c = converter :?> JsonConverter<'T> + c.Read(&reader, typeof<'T>, options) |> Some + + override x.Write(writer, value, options) = + match value with + | Some v -> + let converter = options.GetConverter(typeof<'T>) + let c = converter :?> JsonConverter<'T> + c.Write(writer, v, options) + | None -> + writer.WriteNullValue() + + // The FSharpOptionTypeConverter in STJ seems to be broken + // There is no stable repro to check this, so I used my own Option converter + type OptionConverterFactory() = + inherit JsonConverterFactory() + + override x.CreateConverter(typeToConvert, _) = + let innerType = typeToConvert.GetGenericArguments()[0] + let optionConverterType = typedefof>.MakeGenericType(innerType) + Activator.CreateInstance(optionConverterType) :?> JsonConverter + + override x.CanConvert(typeToConvert) = + match TypeShape.Create(typeToConvert) with + | Shape.FSharpOption _ -> true + | _ -> false + \ No newline at end of file diff --git a/src/VahterBanBot/FakeTgApi.fs b/src/VahterBanBot/FakeTgApi.fs index 08e92d8..8f79be8 100644 --- a/src/VahterBanBot/FakeTgApi.fs +++ b/src/VahterBanBot/FakeTgApi.fs @@ -6,8 +6,7 @@ open System.Net.Http open System.Text open System.Text.Json open System.Threading.Tasks -open Telegram.Bot.Types -open Telegram.Bot.Types.Enums +open Funogram.Telegram.Types open VahterBanBot.Types open VahterBanBot.Utils @@ -30,12 +29,12 @@ let fakeTgApi (botConf: BotConfiguration) = elif url.EndsWith "/sendMessage" then // respond with the request body as a string let message = - Message( - MessageId = 1, - Date = DateTime.UtcNow, - Chat = Chat( - Id = 1L, - Type = ChatType.Private + Message.Create( + messageId = 1, + date = DateTime.UtcNow, + chat = Chat.Create( + id = 1L, + ``type`` = ChatType.Private ) ) |> fun x -> JsonSerializer.Serialize(x, options = jsonOptions) @@ -44,19 +43,25 @@ let fakeTgApi (botConf: BotConfiguration) = // respond with the request body as a string let message = [| - ChatMemberAdministrator( - CanBeEdited = false, - IsAnonymous = false, - CanDeleteMessages = false, - CanManageVideoChats = false, - CanRestrictMembers = false, - CanPromoteMembers = false, - CanChangeInfo = false, - CanInviteUsers = false, - User = User( - Id = 42L, - FirstName = "just_admin", - Username = "just_admin" + ChatMemberAdministrator.Create( + status = "", + canDeleteStories = false, + canEditStories = false, + canPostStories = false, + canInviteUsers = false, + canPromoteMembers = false, + canRestrictMembers = false, + canChangeInfo = false, + canDeleteMessages = false, + canManageChat = false, + isAnonymous = false, + canBeEdited = false, + canManageVideoChats = false, + user = User.Create( + id = 42L, + isBot = false, + firstName = "just_admin", + username = "just_admin" ) ) |] diff --git a/src/VahterBanBot/ML.fs b/src/VahterBanBot/ML.fs index 23f549b..4a69409 100644 --- a/src/VahterBanBot/ML.fs +++ b/src/VahterBanBot/ML.fs @@ -5,13 +5,11 @@ open System.Diagnostics open System.Text open System.Threading open System.Threading.Tasks +open Funogram.Telegram.Types open Microsoft.Extensions.Hosting open Microsoft.Extensions.Logging open Microsoft.ML open Microsoft.ML.Data -open Telegram.Bot -open Telegram.Bot.Types -open Telegram.Bot.Types.Enums open VahterBanBot.DB open VahterBanBot.Types open VahterBanBot.Utils @@ -31,7 +29,7 @@ type Prediction = type MachineLearning( logger: ILogger, - telegramClient: ITelegramBotClient, + telegramClient: TelegramBotClient, botConf: BotConfiguration ) = let metricsToString(metrics: CalibratedBinaryClassificationMetrics) (duration: TimeSpan) = @@ -114,7 +112,7 @@ type MachineLearning( let metricsStr = metricsToString metrics sw.Elapsed logger.LogInformation metricsStr - do! telegramClient.SendTextMessageAsync(ChatId(botConf.LogsChannelId), metricsStr, parseMode = ParseMode.Markdown) + do! telegramClient.SendTextMessageAsync(ChatId.Int(botConf.LogsChannelId), metricsStr, parseMode = ParseMode.Markdown) |> taskIgnore logger.LogInformation "Model trained" with ex -> diff --git a/src/VahterBanBot/Program.fs b/src/VahterBanBot/Program.fs index 5615993..c676551 100644 --- a/src/VahterBanBot/Program.fs +++ b/src/VahterBanBot/Program.fs @@ -2,21 +2,19 @@ open System open System.Collections.Generic +open System.Net.Http open System.Text.Json open System.Text.Json.Serialization -open System.Threading -open System.Threading.Tasks open Dapper +open Funogram.Telegram.Bot +open Funogram.Telegram.Types +open Funogram.Types open Microsoft.AspNetCore.Builder open Microsoft.AspNetCore.Http open Microsoft.Extensions.Logging open Microsoft.FSharp.Core -open Telegram.Bot -open Telegram.Bot.Polling -open Telegram.Bot.Types open Giraffe open Microsoft.Extensions.DependencyInjection -open Telegram.Bot.Types.Enums open VahterBanBot open VahterBanBot.Cleanup open VahterBanBot.ML @@ -55,7 +53,6 @@ let botConf = AllowedUsers = getEnv "ALLOWED_USERS" |> fromJson ShouldDeleteChannelMessages = getEnvOr "SHOULD_DELETE_CHANNEL_MESSAGES" "true" |> bool.Parse IgnoreSideEffects = getEnvOr "IGNORE_SIDE_EFFECTS" "false" |> bool.Parse - UsePolling = getEnvOr "USE_POLLING" "false" |> bool.Parse UseFakeTgApi = getEnvOr "USE_FAKE_TG_API" "false" |> bool.Parse CleanupOldMessages = getEnvOr "CLEANUP_OLD_MESSAGES" "true" |> bool.Parse CleanupInterval = getEnvOr "CLEANUP_INTERVAL_SEC" "86400" |> int |> TimeSpan.FromSeconds @@ -92,21 +89,18 @@ let builder = WebApplication.CreateBuilder() .AddGiraffe() // we need to customize Giraffe STJ settings to conform to the Telegram.Bot API .AddSingleton(Json.Serializer(jsonOptions)) - .ConfigureTelegramBot(fun x -> x.SerializerOptions) + .AddSingleton<_>( + let mutable config = { Config.defaultConfig with Token = botConf.BotToken } + if botConf.UseFakeTgApi then + config <- { config with Client = new HttpClient(fakeTgApi botConf) } + + TelegramBotClient(config) + ) .AddHostedService() .AddHostedService() .AddHostedService() .AddSingleton() .AddHostedService(fun sp -> sp.GetRequiredService()) - .AddHttpClient("telegram_bot_client") - .AddTypedClient(fun httpClient sp -> - let options = TelegramBotClientOptions(botConf.BotToken) - TelegramBotClient(options, httpClient) :> ITelegramBotClient - ) - .ConfigureAdditionalHttpMessageHandlers(fun handlers sp -> - if botConf.UseFakeTgApi then - handlers.Add(fakeTgApi botConf) - ) let otelBuilder = builder.Services @@ -174,7 +168,7 @@ let webApp = choose [ .SetTag("updateBodyJson", updateBodyJson) use scope = ctx.RequestServices.CreateScope() - let telegramClient = scope.ServiceProvider.GetRequiredService() + let telegramClient = scope.ServiceProvider.GetRequiredService() let ml = scope.ServiceProvider.GetRequiredService() let logger = ctx.GetLogger() try @@ -193,23 +187,4 @@ let app = builder.Build() app.UseGiraffe(webApp) let server = app.RunAsync() -// Dev mode only -if botConf.UsePolling then - let telegramClient = app.Services.GetRequiredService() - let pollingHandler = { - new IUpdateHandler with - member x.HandleUpdateAsync (botClient: ITelegramBotClient, update: Update, cancellationToken: CancellationToken) = - task { - if update.Message <> null && update.Message.Type = MessageType.Text then - let ctx = app.Services.CreateScope() - let logger = ctx.ServiceProvider.GetRequiredService>() - let client = ctx.ServiceProvider.GetRequiredService() - let ml = ctx.ServiceProvider.GetRequiredService() - do! onUpdate botUser client botConf logger ml update - } - member this.HandleErrorAsync(botClient, ``exception``, source, cancellationToken) = - Task.CompletedTask - } - telegramClient.StartReceiving(pollingHandler, null, CancellationToken.None) - server.Wait() diff --git a/src/VahterBanBot/StartupMessage.fs b/src/VahterBanBot/StartupMessage.fs index 0aef250..9c44977 100644 --- a/src/VahterBanBot/StartupMessage.fs +++ b/src/VahterBanBot/StartupMessage.fs @@ -2,16 +2,15 @@ module VahterBanBot.StartupMessage open System.Text open System.Threading.Tasks +open Funogram.Telegram.Types open Microsoft.Extensions.Logging -open Telegram.Bot -open Telegram.Bot.Types open VahterBanBot.Types open VahterBanBot.Utils open Microsoft.Extensions.Hosting type StartupMessage( logger: ILogger, - telegramClient: ITelegramBotClient, + telegramClient: TelegramBotClient, botConf: BotConfiguration ) = let getStartLogMsg() = @@ -31,7 +30,7 @@ type StartupMessage( if not botConf.IgnoreSideEffects then let startLogMsg = getStartLogMsg() logger.LogInformation startLogMsg - do! telegramClient.SendTextMessageAsync(ChatId(botConf.LogsChannelId), startLogMsg) + do! telegramClient.SendTextMessageAsync(ChatId.Int(botConf.LogsChannelId), startLogMsg) |> taskIgnore } diff --git a/src/VahterBanBot/TelegramBotClient.fs b/src/VahterBanBot/TelegramBotClient.fs new file mode 100644 index 0000000..373b7be --- /dev/null +++ b/src/VahterBanBot/TelegramBotClient.fs @@ -0,0 +1,48 @@ +namespace VahterBanBot + +open System +open System.Threading.Tasks +open Funogram.Telegram +open Funogram.Api +open Funogram.Telegram.Types +open Funogram.Types + +type TelegramBotClient(config: BotConfig) = + + let sendAndUnwrap request = task { + let! response = api config request |> Async.StartAsTask + return + match response with + | Error e -> raise <| e.AsException() + | Ok result -> result + } + + let unixTimestamp(dto: DateTimeOffset) = dto.ToUnixTimeSeconds() + + member _.SendTextMessageAsync(chatId: ChatId, text: string, ?parseMode: ParseMode, ?replyMarkup: Markup): Task<_> = + Req.SendMessage.Make(chatId = chatId, text = text, ?parseMode = parseMode, ?replyMarkup = replyMarkup) + |> sendAndUnwrap + + member _.GetChatAdministratorsAsync(chatId: ChatId): Task<_> = + Req.GetChatAdministrators.Make chatId + |> sendAndUnwrap + + member _.BanChatMemberAsync(chatId: ChatId, userId: int64, untilDate: DateTimeOffset) = + Req.BanChatMember.Make(chatId, userId, untilDate = unixTimestamp untilDate) + |> sendAndUnwrap + + member _.RestrictChatMemberAsync(chatId: ChatId, userId: int64, permissions: ChatPermissions, untilDate: DateTimeOffset) = + Req.RestrictChatMember.Make(chatId, userId, permissions, untilDate = unixTimestamp untilDate) + |> sendAndUnwrap + + member _.UnbanChatMemberAsync(chatId: ChatId, userId: int64) = + Req.UnbanChatMember.Make(chatId, userId, onlyIfBanned = true) + |> sendAndUnwrap + + member _.DeleteMessageAsync(chatId: ChatId, messageId: int64) = + Req.DeleteMessage.Make(chatId, messageId) + |> sendAndUnwrap + + member _.AnswerCallbackQueryAsync(callbackQueryId: string) = + Req.AnswerCallbackQuery.Make callbackQueryId + |> sendAndUnwrap \ No newline at end of file diff --git a/src/VahterBanBot/Types.fs b/src/VahterBanBot/Types.fs index 4f190a7..36f6dc3 100644 --- a/src/VahterBanBot/Types.fs +++ b/src/VahterBanBot/Types.fs @@ -4,9 +4,8 @@ open System open System.Collections.Generic open System.Text open System.Text.Json -open System.Text.Json.Serialization open Dapper -open Telegram.Bot.Types +open Funogram.Telegram.Types open Utils [] @@ -22,7 +21,6 @@ type BotConfiguration = ShouldDeleteChannelMessages: bool IgnoreSideEffects: bool UseFakeTgApi: bool - UsePolling: bool CleanupOldMessages: bool CleanupInterval: TimeSpan CleanupOldLimit: TimeSpan @@ -58,7 +56,7 @@ type DbUser = created_at = DateTime.UtcNow } static member newUser(user: User) = - DbUser.newUser (id = user.Id, ?username = Option.ofObj user.Username) + DbUser.newUser (id = user.Id, ?username = user.Username) [] type DbBanned = @@ -71,14 +69,14 @@ type DbBanned = banned_by: int64 } module DbBanned = let banMessage (vahter: int64) (message: Message) = - if isNull message.From || isNull message.Chat then + if Option.isNone message.From then failwith "Message should have a user and a chat" - { message_id = Some message.MessageId + { message_id = Some <| message.MessageId32 message_text = message.TextOrCaption - banned_user_id = message.From.Id + banned_user_id = message.FromId banned_at = DateTime.UtcNow banned_in_chat_id = Some message.Chat.Id - banned_in_chat_username = Some message.Chat.Username + banned_in_chat_username = message.Chat.Username banned_by = vahter } [] @@ -89,10 +87,10 @@ type DbMessage = text: string raw_message: string created_at: DateTime } - static member newMessage(message: Telegram.Bot.Types.Message) = + static member newMessage(message: Funogram.Telegram.Types.Message) = { chat_id = message.Chat.Id - message_id = message.MessageId - user_id = message.From.Id + message_id = message.MessageId32 + user_id = message.FromId created_at = DateTime.UtcNow text = message.TextOrCaption raw_message = JsonSerializer.Serialize(message, options = jsonOptions) } @@ -149,9 +147,7 @@ type DbCallback = type CallbackMessageTypeHandler() = inherit SqlMapper.TypeHandler() let callBackOptions = - let opts = JsonFSharpOptions.Default().ToJsonSerializerOptions() - Telegram.Bot.JsonBotAPI.Configure(opts) - opts + jsonOptions override this.SetValue(parameter, value) = parameter.Value <- JsonSerializer.Serialize(value, options = callBackOptions) diff --git a/src/VahterBanBot/UpdateChatAdmins.fs b/src/VahterBanBot/UpdateChatAdmins.fs index 9a29b80..f5b5724 100644 --- a/src/VahterBanBot/UpdateChatAdmins.fs +++ b/src/VahterBanBot/UpdateChatAdmins.fs @@ -3,9 +3,8 @@ open System.Collections.Generic open System.Text open System.Threading.Tasks +open Funogram.Telegram.Types open Microsoft.Extensions.Logging -open Telegram.Bot -open Telegram.Bot.Types open VahterBanBot.Types open VahterBanBot.Utils open System @@ -14,7 +13,7 @@ open Microsoft.Extensions.Hosting type UpdateChatAdmins( logger: ILogger, - telegramClient: ITelegramBotClient, + telegramClient: TelegramBotClient, botConf: BotConfiguration ) = let mutable timer: Timer = null @@ -25,14 +24,14 @@ type UpdateChatAdmins( %sb.AppendLine("New chat admins:") let result = HashSet() for chatId in botConf.ChatsToMonitor.Values do - let! admins = telegramClient.GetChatAdministratorsAsync(ChatId chatId) + let! admins = telegramClient.GetChatAdministratorsAsync(ChatId.Int chatId) // wait a bit so we don't get rate limited do! Task.Delay 100 for admin in admins do if result.Add admin.User.Id then - %sb.AppendJoin(",", $"{prependUsername admin.User.Username} ({admin.User.Id})") + %sb.AppendJoin(",", $"{prependUsernameO admin.User.Username} ({admin.User.Id})") localAdmins <- result logger.LogInformation (sb.ToString()) } diff --git a/src/VahterBanBot/Utils.fs b/src/VahterBanBot/Utils.fs index 3af8c91..a31605f 100644 --- a/src/VahterBanBot/Utils.fs +++ b/src/VahterBanBot/Utils.fs @@ -1,7 +1,11 @@ module VahterBanBot.Utils open System +open System.Text.Json +open System.Text.Json.Serialization open System.Threading.Tasks +open Funogram.Converters +open Funogram.Telegram.Types let inline (~%) x = ignore x @@ -28,12 +32,13 @@ let getEnvOrWith name defaultValue action = action value else defaultValue -let prependUsername (s: string) = - if isNull s then - null - elif s.StartsWith "@" then - s - else "@" + s +let prependUsernameO (s: string option) = + match s with + | None -> null + | Some s when s.StartsWith "@" -> s + | Some s -> s + +let prependUsername (s: string) = prependUsernameO(Some s) let pluralize n s = if n < 2.0 then @@ -57,29 +62,48 @@ type Task<'x> with let inline taskIgnore (t: Task<'x>) = t.Ignore() -type Telegram.Bot.Types.Message with +type Funogram.Telegram.Types.Message with member msg.TextOrCaption = - if isNull msg.Text then - msg.Caption - else - msg.Text + msg.Caption + |> Option.orElse msg.Caption + |> Option.defaultValue "" + + member msg.MessageId32 = // the documentation guarantees that this always fits into int32, Funogram disagrees + Checked.int32 msg.MessageId + + member msg.FromId = // always should be set for chat messages, -1 just in case it is absent + msg.From |> Option.map _.Id |> Option.defaultValue -1 + + member msg.TextOrEmpty = msg.Text |> Option.defaultValue "" + member msg.IsFromBot = msg.From |> Option.map _.IsBot |> Option.defaultValue false + member msg.FromFirstName = msg.From |> Option.map _.FirstName |> Option.defaultValue "" + member msg.FromUsername = msg.From |> Option.bind _.Username |> Option.defaultValue "" -type Telegram.Bot.Types.Update with +type Funogram.Telegram.Types.Update with member msg.EditedOrMessage = - if isNull msg.EditedMessage then - msg.Message - else - msg.EditedMessage + msg.EditedMessage + |> Option.orElse msg.EditedMessage + +type Funogram.Telegram.Types.ChatMember with + member this.User = + match this with + | Owner o -> o.User + | Administrator a -> a.User + | Member m -> m.User + | Restricted r -> r.User + | Left l -> l.User + | Banned b -> b.User // needed for STJ let jsonOptions = - let baseOpts = Microsoft.AspNetCore.Http.Json.JsonOptions() - Telegram.Bot.JsonBotAPI.Configure(baseOpts.SerializerOptions) - - // HACK TIME - // there is a contradiction in Telegram.Bot library where User.IsBot is not nullable and required during deserialization, - // but it is omitted when default on deserialization via settings setup in JsonBotAPI.Configure - // so we'll override this setting explicitly - baseOpts.SerializerOptions.DefaultIgnoreCondition <- System.Text.Json.Serialization.JsonIgnoreCondition.WhenWritingNull - - baseOpts.SerializerOptions + // TODO[F]: Expose this from Funogram + let o = + JsonSerializerOptions( + WriteIndented = false, + PropertyNamingPolicy = JsonNamingPolicy.SnakeCaseLower, + DefaultIgnoreCondition = JsonIgnoreCondition.WhenWritingNull + ) + o.Converters.Add(DiscriminatedUnionConverterFactory()) + o.Converters.Add(UnixTimestampDateTimeConverter()) + o.Converters.Add(OptionConverterFactory()) + o \ No newline at end of file diff --git a/src/VahterBanBot/VahterBanBot.fsproj b/src/VahterBanBot/VahterBanBot.fsproj index fff6a1e..951c84d 100644 --- a/src/VahterBanBot/VahterBanBot.fsproj +++ b/src/VahterBanBot/VahterBanBot.fsproj @@ -7,9 +7,11 @@ + + @@ -35,8 +37,9 @@ - + +