Skip to content

Commit 005cc91

Browse files
SzerSzer
authored
Add forward spam detection via quote text and external reply photo OCR (#115)
* Add forward spam detection via quote text and external reply photo OCR Spam forwarded as "reply to external message" was bypassing ML because the bot only analyzed message.Text/Caption and message.Photo. Now we extract text from message.Quote and run OCR on message.ExternalReply.Photo, prepending the result before the original message text so the ML pipeline sees the full content. Feature-flagged via FORWARD_SPAM_DETECTION_ENABLED (default: true). Made-with: Cursor * Fix null FileSize safety in ocrPhotos and skip enrichment for non-monitored chats - ocrPhotos: handle case where all candidate photos have null FileSize by falling back to largest by dimensions instead of throwing on empty sequence. Extracted selectLargestPhoto to avoid FS3511 in task CE. - tryEnrichMessageWithForwardedContent and tryEnrichMessageWithOcr now skip processing for messages from chats not in ChatsToMonitor, avoiding unnecessary OCR network calls. Made-with: Cursor
1 parent 1dad254 commit 005cc91

File tree

6 files changed

+196
-48
lines changed

6 files changed

+196
-48
lines changed

‎src/VahterBanBot.Tests/ContainerTestBase.fs‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -128,12 +128,15 @@ type VahterTestContainers(mlEnabled: bool) =
128128
.WithEnvironment("REACTION_SPAM_ENABLED", "true")
129129
.WithEnvironment("REACTION_SPAM_MIN_MESSAGES", "3")
130130
.WithEnvironment("REACTION_SPAM_MAX_REACTIONS", "5")
131+
// Forward spam detection
132+
.WithEnvironment("FORWARD_SPAM_DETECTION_ENABLED", "true")
131133
.Build()
132134
else
133135
builder
134136
.WithEnvironment("ML_ENABLED", "false")
135137
.WithEnvironment("OCR_ENABLED", "false")
136138
.WithEnvironment("REACTION_SPAM_ENABLED", "false")
139+
.WithEnvironment("FORWARD_SPAM_DETECTION_ENABLED", "false")
137140
.Build()
138141

139142
let startContainers() = task {

‎src/VahterBanBot.Tests/MLBanTests.fs‎

Lines changed: 66 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -494,4 +494,70 @@ type MLBanTests(fixture: MlEnabledVahterTestContainers, _unused: MlAwaitFixture)
494494
Assert.True(userBanned, "User should be auto-banned after reaching karma threshold via soft spam")
495495
}
496496

497+
[<Fact>]
498+
let ``Message with spam in quote text triggers auto-delete`` () = task {
499+
let msgUpdate = Tg.quickMsg(
500+
chat = fixture.ChatsToMonitor[0],
501+
text = "hello",
502+
quote = Tg.textQuote("2222222")
503+
)
504+
let! _ = fixture.SendMessage msgUpdate
505+
506+
let! msgBanned = fixture.MessageIsAutoDeleted msgUpdate.Message
507+
Assert.True msgBanned
508+
}
509+
510+
[<Fact>]
511+
let ``Message with non-spam quote text does NOT trigger auto-delete`` () = task {
512+
let msgUpdate = Tg.quickMsg(
513+
chat = fixture.ChatsToMonitor[0],
514+
text = "hello",
515+
quote = Tg.textQuote("b")
516+
)
517+
let! _ = fixture.SendMessage msgUpdate
518+
519+
let! msgBanned = fixture.MessageIsAutoDeleted msgUpdate.Message
520+
Assert.False msgBanned
521+
}
522+
523+
[<Fact>]
524+
let ``Quote text is prepended to message text`` () = task {
525+
let msgUpdate = Tg.quickMsg(
526+
chat = fixture.ChatsToMonitor[0],
527+
text = "hello",
528+
quote = Tg.textQuote("b")
529+
)
530+
let! _ = fixture.SendMessage msgUpdate
531+
532+
let! dbMsg = fixture.TryGetDbMessage msgUpdate.Message
533+
Assert.True dbMsg.IsSome
534+
Assert.Equal("b\nhello", dbMsg.Value.text)
535+
}
536+
537+
[<Fact>]
538+
let ``Spam in external reply photo triggers auto-delete via OCR`` () = task {
539+
let msgUpdate = Tg.quickMsg(
540+
chat = fixture.ChatsToMonitor[0],
541+
text = "hello",
542+
externalReply = Tg.externalReply(photos = [| Tg.spamPhoto |])
543+
)
544+
let! _ = fixture.SendMessage msgUpdate
545+
546+
let! msgBanned = fixture.MessageIsAutoDeleted msgUpdate.Message
547+
Assert.True msgBanned
548+
}
549+
550+
[<Fact>]
551+
let ``Ham in external reply photo does NOT trigger auto-delete`` () = task {
552+
let msgUpdate = Tg.quickMsg(
553+
chat = fixture.ChatsToMonitor[0],
554+
text = "hello",
555+
externalReply = Tg.externalReply(photos = [| Tg.hamPhoto |])
556+
)
557+
let! _ = fixture.SendMessage msgUpdate
558+
559+
let! msgBanned = fixture.MessageIsAutoDeleted msgUpdate.Message
560+
Assert.False msgBanned
561+
}
562+
497563
interface IClassFixture<MlAwaitFixture>

‎src/VahterBanBot.Tests/TgMessageUtils.fs‎

Lines changed: 13 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -60,7 +60,16 @@ type Tg() =
6060
static member emoji(?offset: int) = MessageEntity(Type = MessageEntityType.CustomEmoji, Offset = defaultArg offset 0 , Length = 1)
6161
static member emojies(n: int) = Array.init n (fun i -> Tg.emoji i)
6262

63-
static member quickMsg (?text: string, ?chat: Chat, ?from: User, ?date: DateTime, ?callback: CallbackQuery, ?caption: string, ?editedText: string, ?entities: MessageEntity[], ?photos: PhotoSize[], ?isAutomaticForward: bool, ?senderChat: Chat) =
63+
static member textQuote(text: string) =
64+
TextQuote(Text = text, Position = 0)
65+
66+
static member externalReply(?photos: PhotoSize[], ?chat: Chat) =
67+
ExternalReplyInfo(
68+
Photo = (photos |> Option.defaultValue null),
69+
Chat = (chat |> Option.defaultValue null)
70+
)
71+
72+
static member quickMsg (?text: string, ?chat: Chat, ?from: User, ?date: DateTime, ?callback: CallbackQuery, ?caption: string, ?editedText: string, ?entities: MessageEntity[], ?photos: PhotoSize[], ?isAutomaticForward: bool, ?senderChat: Chat, ?quote: TextQuote, ?externalReply: ExternalReplyInfo) =
6473
let updateId = next()
6574
let msgId = next()
6675
Update(
@@ -77,7 +86,9 @@ type Tg() =
7786
Entities = (entities |> Option.defaultValue null),
7887
Photo = (photos |> Option.defaultValue null),
7988
IsAutomaticForward = (isAutomaticForward |> Option.defaultValue false),
80-
SenderChat = (senderChat |> Option.defaultValue null)
89+
SenderChat = (senderChat |> Option.defaultValue null),
90+
Quote = (quote |> Option.defaultValue null),
91+
ExternalReply = (externalReply |> Option.defaultValue null)
8192
),
8293
EditedMessage =
8394
if editedText |> Option.isSome then

‎src/VahterBanBot/Bot.fs‎

Lines changed: 108 additions & 44 deletions
Original file line numberDiff line numberDiff line change
@@ -889,6 +889,96 @@ let onMessage
889889
do! justMessage botUser botClient botConfig logger ml message
890890
}
891891

892+
let private selectLargestPhoto (photos: PhotoSize array) =
893+
let withSize = photos |> Array.filter (fun p -> p.FileSize.HasValue)
894+
if withSize.Length > 0 then
895+
withSize |> Array.maxBy (fun p -> p.FileSize.Value)
896+
else
897+
photos |> Array.maxBy (fun p -> p.Width * p.Height)
898+
899+
let private ocrPhotos
900+
(botClient: ITelegramBotClient)
901+
(botConfig: BotConfiguration)
902+
(computerVision: IComputerVision)
903+
(logger: ILogger)
904+
(photos: PhotoSize array)
905+
(messageId: int) = task {
906+
let candidatePhotos =
907+
photos
908+
|> Array.filter (fun p ->
909+
let size = int64 p.FileSize
910+
size = 0L || size <= botConfig.OcrMaxFileSizeBytes)
911+
912+
if candidatePhotos.Length = 0 then
913+
logger.LogWarning(
914+
"No photos under OCR limit of {LimitBytes} bytes for message {MessageId}",
915+
botConfig.OcrMaxFileSizeBytes,
916+
messageId)
917+
return None
918+
else
919+
let largestPhoto = selectLargestPhoto candidatePhotos
920+
921+
let! file = botClient.GetFile(largestPhoto.FileId)
922+
923+
if String.IsNullOrWhiteSpace file.FilePath then
924+
logger.LogWarning("Failed to resolve file path for photo {PhotoId}", largestPhoto.FileId)
925+
return None
926+
else
927+
let fileUrl = $"https://api.telegram.org/file/bot{botConfig.BotToken}/{file.FilePath}"
928+
let! ocrText = computerVision.TextFromImageUrl fileUrl
929+
if String.IsNullOrWhiteSpace ocrText then
930+
return None
931+
else
932+
return Some ocrText
933+
}
934+
935+
let tryEnrichMessageWithForwardedContent
936+
(botClient: ITelegramBotClient)
937+
(botConfig: BotConfiguration)
938+
(computerVision: IComputerVision)
939+
(logger: ILogger)
940+
(update: Update) = task {
941+
if botConfig.ForwardSpamDetectionEnabled then
942+
let message = update.EditedOrMessage
943+
if not (isNull message) && isMessageFromAllowedChats botConfig message then
944+
use activity = botActivity.StartActivity("forwardedContentEnrichment")
945+
try
946+
let mutable forwardedText: string = null
947+
948+
if not (isNull message.Quote)
949+
&& not (String.IsNullOrWhiteSpace message.Quote.Text) then
950+
forwardedText <- message.Quote.Text
951+
%activity.SetTag("quoteTextLength", message.Quote.Text.Length)
952+
953+
if botConfig.OcrEnabled
954+
&& not (isNull message.ExternalReply)
955+
&& not (isNull message.ExternalReply.Photo)
956+
&& message.ExternalReply.Photo.Length > 0 then
957+
let! ocrText = ocrPhotos botClient botConfig computerVision logger message.ExternalReply.Photo message.MessageId
958+
match ocrText with
959+
| Some text ->
960+
forwardedText <-
961+
if isNull forwardedText then text
962+
else $"{forwardedText}\n{text}"
963+
%activity.SetTag("externalReplyOcrLength", text.Length)
964+
| None -> ()
965+
966+
if not (String.IsNullOrWhiteSpace forwardedText) then
967+
let baseText = message.TextOrCaption
968+
let enrichedText =
969+
if String.IsNullOrWhiteSpace baseText then forwardedText
970+
else $"{forwardedText}\n{baseText}"
971+
logger.LogDebug(
972+
"Enriched message {MessageId} with forwarded content of length {ForwardedLength}",
973+
message.MessageId,
974+
forwardedText.Length
975+
)
976+
message.Text <- enrichedText
977+
%activity.SetTag("enrichedTextLength", enrichedText.Length)
978+
with ex ->
979+
logger.LogError(ex, "Failed to process forwarded content for message {MessageId}", update.EditedOrMessage.MessageId)
980+
}
981+
892982
let tryEnrichMessageWithOcr
893983
(botClient: ITelegramBotClient)
894984
(botConfig: BotConfiguration)
@@ -897,52 +987,25 @@ let tryEnrichMessageWithOcr
897987
(update: Update) = task {
898988
if botConfig.OcrEnabled then
899989
let message = update.EditedOrMessage
900-
if not (isNull message.Photo) && message.Photo.Length > 0 then
990+
if not (isNull message.Photo) && message.Photo.Length > 0 && isMessageFromAllowedChats botConfig message then
901991
use activity = botActivity.StartActivity("ocrEnrichment")
902992
try
903-
let candidatePhotos =
904-
message.Photo
905-
|> Array.filter (fun p ->
906-
let size = int64 p.FileSize
907-
size = 0L || size <= botConfig.OcrMaxFileSizeBytes)
908-
909-
if candidatePhotos.Length = 0 then
910-
logger.LogWarning(
911-
"No photos under OCR limit of {LimitBytes} bytes for message {MessageId}",
912-
botConfig.OcrMaxFileSizeBytes,
913-
message.MessageId)
914-
else
915-
let largestPhoto =
916-
candidatePhotos
917-
|> Seq.filter (fun p -> p.FileSize.HasValue)
918-
|> Seq.maxBy (fun p -> p.FileSize.Value)
919-
920-
%activity.SetTag("photoId", largestPhoto.FileId)
921-
922-
let! file = botClient.GetFile(largestPhoto.FileId)
923-
924-
if String.IsNullOrWhiteSpace file.FilePath then
925-
logger.LogWarning("Failed to resolve file path for photo {PhotoId}", largestPhoto.FileId)
926-
else
927-
let fileUrl = $"https://api.telegram.org/file/bot{botConfig.BotToken}/{file.FilePath}"
928-
%activity.SetTag("fileUrl", fileUrl)
929-
let! ocrText = computerVision.TextFromImageUrl fileUrl
930-
931-
if not (String.IsNullOrWhiteSpace ocrText) then
932-
let baseText = message.TextOrCaption
933-
let enrichedText =
934-
if String.IsNullOrWhiteSpace baseText then
935-
ocrText
936-
else
937-
$"{baseText}\n{ocrText}"
938-
logger.LogDebug (
939-
"Enriched message {MessageId} with OCR text {EnrichedText} of length {OcrTextLength}",
940-
update.EditedOrMessage.MessageId,
941-
enrichedText,
942-
ocrText.Length
943-
)
944-
message.Text <- enrichedText
945-
%activity.SetTag("ocrTextLength", enrichedText.Length)
993+
let! ocrResult = ocrPhotos botClient botConfig computerVision logger message.Photo message.MessageId
994+
match ocrResult with
995+
| Some ocrText ->
996+
let baseText = message.TextOrCaption
997+
let enrichedText =
998+
if String.IsNullOrWhiteSpace baseText then ocrText
999+
else $"{baseText}\n{ocrText}"
1000+
logger.LogDebug (
1001+
"Enriched message {MessageId} with OCR text {EnrichedText} of length {OcrTextLength}",
1002+
update.EditedOrMessage.MessageId,
1003+
enrichedText,
1004+
ocrText.Length
1005+
)
1006+
message.Text <- enrichedText
1007+
%activity.SetTag("ocrTextLength", enrichedText.Length)
1008+
| None -> ()
9461009
with ex ->
9471010
logger.LogError(ex, "Failed to process OCR for message {MessageId}", update.EditedOrMessage.MessageId)
9481011
}
@@ -1222,6 +1285,7 @@ let onUpdate
12221285
elif update.MessageReaction <> null then
12231286
do! onMessageReaction botClient botConfig logger update.MessageReaction
12241287
elif update.EditedOrMessage <> null then
1288+
do! tryEnrichMessageWithForwardedContent botClient botConfig computerVision logger update
12251289
do! tryEnrichMessageWithOcr botClient botConfig computerVision logger update
12261290
do! onMessage botUser botClient botConfig logger ml update.EditedOrMessage
12271291
elif update.ChatMember <> null || update.MyChatMember <> null then

‎src/VahterBanBot/Program.fs‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -101,7 +101,9 @@ let botConf =
101101
// Reaction spam detection
102102
ReactionSpamEnabled = getEnvOr "REACTION_SPAM_ENABLED" "false" |> bool.Parse
103103
ReactionSpamMinMessages = getEnvOr "REACTION_SPAM_MIN_MESSAGES" "10" |> int
104-
ReactionSpamMaxReactions = getEnvOr "REACTION_SPAM_MAX_REACTIONS" "5" |> int }
104+
ReactionSpamMaxReactions = getEnvOr "REACTION_SPAM_MAX_REACTIONS" "5" |> int
105+
// Forward spam detection
106+
ForwardSpamDetectionEnabled = getEnvOr "FORWARD_SPAM_DETECTION_ENABLED" "true" |> bool.Parse }
105107

106108
let validateApiKey (ctx : HttpContext) =
107109
match ctx.TryGetRequestHeader "X-Telegram-Bot-Api-Secret-Token" with

‎src/VahterBanBot/Types.fs‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -60,7 +60,9 @@ type BotConfiguration =
6060
// Reaction spam detection
6161
ReactionSpamEnabled: bool
6262
ReactionSpamMinMessages: int
63-
ReactionSpamMaxReactions: int }
63+
ReactionSpamMaxReactions: int
64+
// Forward spam detection
65+
ForwardSpamDetectionEnabled: bool }
6466

6567
[<CLIMutable>]
6668
type DbUser =

0 commit comments

Comments
 (0)