moved banned information to separate table (#22)

.env.example

@@ -11,3 +11,7 @@ DATABASE_URL=Server=localhost;Database=vahter_bot_ban;Port=5432;User Id=vahter_b
 OTEL_EXPORTER_ZIPKIN_ENDPOINT=http://zipkin:9411/api/v2/spans
 OTEL_EXPORTER_CONSOLE=false
 IGNORE_SIDE_EFFECTS=true
+USE_FAKE_TG_API=false
+CLEANUP_OLD_MESSAGES=true
+CLEANUP_INTERVAL_SEC=86400
+CLEANUP_OLD_LIMIT_SEC=259200

src/VahterBanBot.Tests/BanTests.fs

@@ -0,0 +1,76 @@
+module VahterBanBot.Tests.BanTests
+
+open System.Net
+open VahterBanBot.Tests.ContainerTestBase
+open VahterBanBot.Tests.TgMessageUtils
+open Xunit
+
+type BanTests(fixture: VahterTestContainers) =
+
+    [<Fact>]
+    let ``Vahter can ban on reply`` () = task {
+        // record a message
+        let msgUpdate = Tg.quickMsg(chat = fixture.ChatsToMonitor[0])
+        let! _ = fixture.SendMessage msgUpdate
+
+        // send the ban message
+        let! banResp =
+            Tg.replyMsg(msgUpdate.Message, "/ban", fixture.AdminUsers[0])
+            |> fixture.SendMessage
+        Assert.Equal(HttpStatusCode.OK, banResp.StatusCode)
+
+        // assert that the message got banned
+        let! msgBanned = fixture.MessageBanned msgUpdate.Message
+        Assert.True msgBanned
+    }
+
+    [<Fact>]
+    let ``NON Vahter can't ban on reply`` () = task {
+        // record a message
+        let msgUpdate = Tg.quickMsg(chat = fixture.ChatsToMonitor[0])
+        let! _ = fixture.SendMessage msgUpdate
+
+        // send the ban message from a non-admin user
+        let! banResp =
+            Tg.replyMsg(msgUpdate.Message, "/ban", Tg.user())
+            |> fixture.SendMessage
+        Assert.Equal(HttpStatusCode.OK, banResp.StatusCode)
+
+        // assert that the message NOT banned
+        let! msgNotBanned = fixture.MessageBanned msgUpdate.Message
+        Assert.False msgNotBanned
+    }
+
+    [<Fact>]
+    let ``Vahter can't ban on reply in non-allowed chat`` () = task {
+        // record a message in a random chat
+        let msgUpdate = Tg.quickMsg(chat = Tg.chat())
+        let! _ = fixture.SendMessage msgUpdate
+
+        // send the ban message
+        let! banResp =
+            Tg.replyMsg(msgUpdate.Message, "/ban", fixture.AdminUsers[0])
+            |> fixture.SendMessage
+        Assert.Equal(HttpStatusCode.OK, banResp.StatusCode)
+
+        // assert that the message NOT banned
+        let! msgNotBanned = fixture.MessageBanned msgUpdate.Message
+        Assert.False msgNotBanned
+    }
+
+    [<Fact>]
+    let ``Vahter can't ban another vahter`` () = task {
+        // record a message in a random chat
+        let msgUpdate = Tg.quickMsg(chat = fixture.ChatsToMonitor[0], from = fixture.AdminUsers[0])
+        let! _ = fixture.SendMessage msgUpdate
+
+        // send the ban message
+        let! banResp =
+            Tg.replyMsg(msgUpdate.Message, "/ban", fixture.AdminUsers[1])
+            |> fixture.SendMessage
+        Assert.Equal(HttpStatusCode.OK, banResp.StatusCode)
+
+        // assert that the message NOT banned
+        let! msgNotBanned = fixture.MessageBanned msgUpdate.Message
+        Assert.False msgNotBanned
+    }

src/VahterBanBot.Tests/ContainerTestBase.fs

@@ -165,3 +165,11 @@ type VahterTestContainers() =
         let! count = conn.QuerySingleAsync<int>(sql, {| chatId = msg.Chat.Id; messageId = msg.MessageId |})
         return count = 1
     }
+
+    member _.MessageBanned(msg: Message) = task {
+        use conn = new NpgsqlConnection(publicConnectionString)
+        //language=postgresql
+        let sql = "SELECT COUNT(*) FROM banned WHERE banned_in_chat_id = @chatId AND message_id = @messageId"
+        let! count = conn.QuerySingleAsync<int>(sql, {| chatId = msg.Chat.Id; messageId = msg.MessageId |})
+        return count > 0
+    }

src/VahterBanBot.Tests/TgMessageUtils.fs

@@ -1,30 +1,48 @@
 module VahterBanBot.Tests.TgMessageUtils
 
 open System
+open System.Threading
 open Telegram.Bot.Types
 
 type Tg() =
-    static let rnd = Random.Shared
+    static let mutable i = 0L
+    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 (rnd.NextInt64())),
+            Id = (id |> Option.defaultValue (nextInt64())),
             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 (rnd.NextInt64())),
+            Id = (id |> Option.defaultValue (nextInt64())),
             Username = (username |> Option.defaultValue null)
         )
     static member quickMsg (?text: string, ?chat: Chat, ?from: User, ?date: DateTime) =
         Update(
-            Id = rnd.Next(),
+            Id = next(),
             Message = 
                 Message(
-                    MessageId = rnd.Next(),
+                    MessageId = next(),
                     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)
+                    Date = (date |> Option.defaultValue DateTime.UtcNow),
+                    ReplyToMessage = 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
                 )
             )

src/VahterBanBot.Tests/VahterBanBot.Tests.fsproj

@@ -12,6 +12,7 @@
         <Compile Include="TgMessageUtils.fs" />
         <Compile Include="ContainerTestBase.fs" />
         <Compile Include="BaseTests.fs" />
+        <Compile Include="BanTests.fs" />
         <Compile Include="PingTests.fs" />
         <Compile Include="Program.fs"/>
     </ItemGroup>

src/VahterBanBot/Bot.fs

@@ -259,10 +259,9 @@ let banOnReply
             |> safeTaskAwait (fun e -> logger.LogError ($"Failed to delete reply message {message.ReplyToMessage.MessageId} from chat {message.Chat.Id}", e))
     }
     // update user in DB
-    let banUserInDb =
+    let updatedUser =
         message.ReplyToMessage.From
         |> DbUser.newUser
-        |> DbUser.banUser message.From.Id (Option.ofObj message.ReplyToMessage.Text)
         |> DB.upsertUser
 
     let deletedUserMessagesTask = task {
@@ -296,13 +295,18 @@ let banOnReply
     let! deletedUserMessages = deletedUserMessagesTask
 
     // produce aggregated log message
-    let logMsg = aggregateBanResultInLogMsg message logger deletedUserMessages banResults 
+    let logMsg = aggregateBanResultInLogMsg message logger deletedUserMessages banResults
+
+    // add ban record to DB
+    do! message.ReplyToMessage
+        |> DbBanned.banMessage message.From.Id
+        |> DB.banUser
 
     // log both to logger and to logs channel
     do! botClient.SendTextMessageAsync(ChatId(botConfig.LogsChannelId), logMsg) |> taskIgnore
     logger.LogInformation logMsg
 
-    do! banUserInDb.Ignore()
+    do! updatedUser.Ignore()
     do! deleteReplyTask
 }
 
@@ -358,17 +362,9 @@ let unban
         .SetTag("targetId", targetUserId)
 
     let! user = DB.getUserById targetUserId
-    let unbanUserTask = task {
-        if user.IsSome then
-            %banOnReplyActivity.SetTag("targetUsername", user.Value.Username)
-            let! unbannedUser =
-                user.Value
-                |> DbUser.unban
-                |> DB.upsertUser
-            return Some unbannedUser
-        else
-            return None
-    }
+    if user.IsSome then
+        %banOnReplyActivity.SetTag("targetUsername", user.Value.Username)
+
     let targetUsername = user |> Option.bind (fun u -> u.Username)
 
     // try unban user in all monitored chats
@@ -380,8 +376,6 @@ let unban
     // log both to logger and to logs channel
     do! botClient.SendTextMessageAsync(ChatId(botConfig.LogsChannelId), logMsg) |> taskIgnore
     logger.LogInformation logMsg
-
-    do! unbanUserTask.Ignore()
 }
 
 let warnSpamDetection

src/VahterBanBot/Cleanup.fs

@@ -16,22 +16,14 @@ type CleanupService(
     telegramClient: ITelegramBotClient,
     botConf: BotConfiguration
 ) =
-    let cleanupInterval =
-        getEnvOr "MESSAGES_CLEANUP_INTERVAL_SEC" "86400" // 1 day
-        |> int
-        |> TimeSpan.FromSeconds
-    let cleanupOldLimit =
-        getEnvOr "MESSAGES_CLEANUP_OLD_LIMIT_SEC" "259200" // 3 days
-        |> int
-        |> TimeSpan.FromSeconds
     let mutable timer: Timer = null
 
     let cleanup _ = task {
-        let! cleanupMsgs = DB.cleanupOldMessages cleanupOldLimit
-        let! vahterStats = DB.getVahterStats (Some cleanupInterval)
+        let! cleanupMsgs = DB.cleanupOldMessages botConf.CleanupOldLimit
+        let! vahterStats = DB.getVahterStats (Some botConf.CleanupInterval)
 
         let sb = StringBuilder()
-        %sb.AppendLine $"Cleaned up {cleanupMsgs} messages from DB which are older than {timeSpanAsHumanReadable cleanupOldLimit}"
+        %sb.AppendLine $"Cleaned up {cleanupMsgs} messages from DB which are older than {timeSpanAsHumanReadable botConf.CleanupOldLimit}"
         %sb.AppendLine(string vahterStats)
 
         let msg = sb.ToString()
@@ -44,8 +36,8 @@ type CleanupService(
 
     interface IHostedService with
         member this.StartAsync _ =
-            if not botConf.IgnoreSideEffects then
-                timer <- new Timer(TimerCallback(cleanup >> ignore), null, TimeSpan.Zero, cleanupInterval)
+            if botConf.CleanupOldMessages then
+                timer <- new Timer(TimerCallback(cleanup >> ignore), null, TimeSpan.Zero, botConf.CleanupInterval)
             Task.CompletedTask
 
         member this.StopAsync _ =

src/VahterBanBot/DB.fs

@@ -16,13 +16,10 @@ let upsertUser (user: DbUser): Task<DbUser> =
         //language=postgresql
         let sql =
             """
-INSERT INTO "user" (id, username, ban_reason, banned_at, banned_by, created_at, updated_at)
-VALUES (@id, @username, @banReason, @bannedAt, @bannedBy, @createdAt, @updatedAt)
+INSERT INTO "user" (id, username, created_at, updated_at)
+VALUES (@id, @username, @createdAt, @updatedAt)
 ON CONFLICT (id) DO UPDATE
     SET username   = COALESCE("user".username, EXCLUDED.username),
-        ban_reason = COALESCE("user".ban_reason, EXCLUDED.ban_reason),
-        banned_at  = COALESCE("user".banned_at, EXCLUDED.banned_at),
-        banned_by  = COALESCE("user".banned_by, EXCLUDED.banned_by),
         updated_at = GREATEST(EXCLUDED.updated_at, "user".updated_at)
 RETURNING *;
 """
@@ -32,9 +29,6 @@ RETURNING *;
                 sql,
                 {| id = user.Id
                    username = user.Username
-                   banReason = user.Ban_Reason
-                   bannedAt = user.Banned_At
-                   bannedBy = user.Banned_By
                    createdAt = user.Created_At
                    updatedAt = user.Updated_At |}
             )
@@ -69,6 +63,30 @@ ON CONFLICT (chat_id, message_id) DO NOTHING RETURNING *;
             |> Option.defaultValue message
 }
 
+let banUser (banned: DbBanned): Task =
+    task {
+        use conn = new NpgsqlConnection(connString)
+
+        //language=postgresql
+        let sql =
+            """
+INSERT INTO banned (message_id, message_text, banned_user_id, banned_at, banned_in_chat_id, banned_in_chat_username, banned_by)
+VALUES (@messageId, @messageText, @bannedUserId, @bannedAt, @bannedInChatId, @bannedInChatUsername, @bannedBy)
+            """
+
+        let! _ = conn.ExecuteAsync(
+                sql,
+                {| messageId = banned.Message_Id
+                   messageText = banned.Message_text
+                   bannedUserId = banned.Banned_User_Id
+                   bannedAt = banned.Banned_At
+                   bannedInChatId = banned.Banned_In_Chat_Id
+                   bannedInChatUsername = banned.Banned_In_Chat_username
+                   bannedBy = banned.Banned_By |}
+        )
+        return banned
+    }
+
 let getUserMessages (userId: int64): Task<DbMessage array> =
     task {
         use conn = new NpgsqlConnection(connString)
@@ -102,17 +120,16 @@ let cleanupOldMessages (howOld: TimeSpan): Task<int> =
 let getVahterStats(banInterval: TimeSpan option): Task<VahterStats> =
     task {
         use conn = new NpgsqlConnection(connString)
-
+        
         //language=postgresql
         let sql =
             """
 SELECT vahter.username                                                      AS vahter
      , COUNT(*)                                                             AS killCountTotal
-     , COUNT(*) FILTER (WHERE u.banned_at > NOW() - @banInterval::INTERVAL) AS killCountInterval
-FROM "user" u
-         JOIN "user" vahter ON vahter.id = u.banned_by
-WHERE u.banned_by IS NOT NULL
-GROUP BY u.banned_by, vahter.username
+     , COUNT(*) FILTER (WHERE b.banned_at > NOW() - @banInterval::INTERVAL) AS killCountInterval
+FROM banned b
+         JOIN "user" vahter ON vahter.id = b.banned_by
+GROUP BY b.banned_by, vahter.username
 ORDER BY killCountTotal DESC
             """
 
@@ -128,4 +145,4 @@ let getUserById (userId: int64): Task<DbUser option> =
         let sql = "SELECT * FROM \"user\" WHERE id = @userId"
         let! users = conn.QueryAsync<DbUser>(sql, {| userId = userId |})
         return users |> Seq.tryHead
-    }
+    }

src/VahterBanBot/Program.fs

@@ -40,7 +40,10 @@ let botConf =
       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 }
+      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
+      CleanupOldLimit = getEnvOr "CLEANUP_OLD_LIMIT_SEC" "259200" |> int |> TimeSpan.FromSeconds }
 
 let validateApiKey (ctx : HttpContext) =
     match ctx.TryGetRequestHeader "X-Telegram-Bot-Api-Secret-Token" with