publishhelperbot/PublishHelperBot/Telegram.fs
2023-02-26 20:08:42 +04:00

297 lines
12 KiB
Forth

module PublishHelperBot.Telegram
open System
open System.IO
open Microsoft.FSharp.Control
open PublishHelperBot.Environment
open PublishHelperBot.Types
open Telegram.Bot
open Telegram.Bot.Types
open Telegram.Bot.Types.Enums
open Telegram.Bot.Types.InputFiles
[<RequireQualifiedAccess>]
module BotUpdateType =
let private getRelayCaptionType (command: string) =
match command with
| _ when command.StartsWith "\\post anon" -> Anonymous
| _ when command.StartsWith "\\post" -> WithAuthor
| _ -> Unknown
let private updateIsAMessage (update: Update) =
update.Type = UpdateType.Message
let private fromAdminChat (message: Message, adminChatId: ConfigChatId) =
message.Chat.Id = adminChatId
let private hasReply (x: Message) =
not (isNull x.ReplyToMessage)
let private hasText (x: Message) =
not (isNull x.Text)
let private hasRelaySupportedContent (x: Message) =
match x.Type with
| MessageType.Text -> true
| MessageType.Photo -> true
| MessageType.Video -> true
| _ -> false
let [<Literal>] private YoutubeRepostMatchCmd = "\\ytdl"
let private isYoutubeRepost (update: Update, adminChatId: ConfigChatId) =
updateIsAMessage update &&
fromAdminChat (update.Message, adminChatId) &&
hasText update.Message &&
update.Message.Text.StartsWith YoutubeRepostMatchCmd &&
update.Message.Text.Split(' ').Length = 2
let private isRelay (update: Update, adminChatId: ConfigChatId) =
updateIsAMessage update &&
fromAdminChat (update.Message, adminChatId) &&
hasReply update.Message &&
hasRelaySupportedContent update.Message.ReplyToMessage &&
not (getRelayCaptionType update.Message.Text = RelayCaptionMode.Unknown)
let private isPing (update: Update, adminChatId: ConfigChatId) =
updateIsAMessage update &&
fromAdminChat (update.Message, adminChatId) &&
hasText update.Message &&
update.Message.Text.StartsWith("\ping")
let getUpdateType (update: Update) (config: BotConfig) =
match update with
| _ when isPing (update, config.adminChatId) ->
BotUpdateType.Ping
| _ when isYoutubeRepost(update, config.adminChatId) ->
let url = update.Message.Text.Split(' ').[1]
BotUpdateType.YoutubeRepost url
| _ when isRelay(update, config.adminChatId) ->
let reply = update.Message.ReplyToMessage
let getCaption() =
let captionMode = getRelayCaptionType update.Message.Text
let author = $"{reply.From.FirstName} {reply.From.LastName}"
match captionMode with
| WithAuthor -> $"<a href=\"{config.relayUrl}\">Прислал</a> {author}"
| _ -> null
match reply.Type with
| MessageType.Text ->
let args = {
ReplyChatId = reply.Chat.Id
ReplyMessageId = reply.MessageId
Relay = RelayType.Text
}
BotUpdateType.RelayUpdate args
| MessageType.Photo ->
let caption = getCaption()
let media =
reply.Photo
|> Array.map (fun (p: PhotoSize) -> p.FileId)
|> Array.tryHead
match media with
| Some media ->
let args = {
ReplyChatId = reply.Chat.Id
ReplyMessageId = reply.MessageId
Relay = RelayType.Photo (media, caption)
}
BotUpdateType.RelayUpdate args
| None ->
BotUpdateType.Skip
| MessageType.Video ->
let caption = getCaption()
let args = {
ReplyChatId = reply.Chat.Id
ReplyMessageId = reply.MessageId
Relay = RelayType.Video (reply.Video.FileId, caption)
}
BotUpdateType.RelayUpdate args
| _ ->
BotUpdateType.Skip
| _ ->
BotUpdateType.Skip
[<RequireQualifiedAccess>]
module TgService =
type private Msg =
| Ping
| PostVideo of url: string * savePath: string * externalId: Guid
| PostRelay of RelayArgs
| PostMessageToAdminChat of text: string
let private createInbox (config: TgServiceConfig) =
MailboxProcessor.Start(fun inbox ->
let rec loop () =
async {
match! inbox.Receive() with
| Ping ->
Logging.logger.Information("Sending ГЫЧА)))0")
let sticker = InputOnlineFile(
value = "CAACAgIAAx0CQj8KlAACBPBj-ylrAcDqnwvpgEssCuN0aTilywACoxYAAvy_sEqzXsNGSWYfpS4E"
)
do!
config.Client.SendStickerAsync(
config.AdminChatId,
sticker
)
|> Async.AwaitTask
|> Async.Catch
|> Async.Ignore
return! loop ()
| PostRelay args ->
Logging.logger.Information("Posting relay, relay = {relay}", args)
match args.Relay with
| RelayType.Text ->
do!
config.Client.ForwardMessageAsync(
config.ChannelId,
args.ReplyChatId,
args.ReplyMessageId
)
|> Async.AwaitTask
|> Async.Catch
|> Async.Ignore
| RelayType.Photo(media, caption) ->
do!
config.Client.SendPhotoAsync(
config.ChannelId,
media,
caption,
parseMode = ParseMode.Html
)
|> Async.AwaitTask
|> Async.Catch
|> Async.Ignore
| RelayType.Video(media, caption) ->
do!
config.Client.SendVideoAsync(
config.ChannelId,
media,
caption = caption,
parseMode = ParseMode.Html
)
|> Async.AwaitTask
|> Async.Catch
|> Async.Ignore
return! loop ()
| PostMessageToAdminChat text ->
do!
config.Client.SendTextMessageAsync(
config.AdminChatId, text
)
|> Async.AwaitTask
|> Async.Catch
|> Async.Ignore
return! loop ()
| PostVideo (url, savePath, externalId) ->
try
Logging.logger.Information("Reading file path = {path}", savePath)
use file = File.OpenRead(savePath)
if (file.Length / 1024L / 1024L) < 50L then
let input = InputOnlineFile(file, Path.GetRandomFileName())
let caption = $"Source: {url}"
Logging.logger.Information(
"Sending video to channel, channelId = {channelId}, caption = {caption}",
config.ChannelId,
caption)
do! config.Client.SendVideoAsync(
config.ChannelId,
input,
caption = caption
)
|> Async.AwaitTask
|> Async.Catch
|> Async.Ignore
else
inbox.Post(PostMessageToAdminChat($"Да блять, видео вышло больше 50мб: {externalId}"))
finally
Logging.logger.Information("Deleting file path = {path}", savePath)
File.Delete(savePath)
match! config.YoutubeDlClient.CleanJob(externalId) with
| Ok _ -> ()
| Error _ -> ()
return! loop ()
}
loop ()
)
let createService config =
let inbox = createInbox config
{ new ITgService with
member this.PostRelay(args) =
inbox.Post(PostRelay(args))
member this.Ping() =
inbox.Post(Ping)
member this.PostMessageToAdminChat(text) =
inbox.Post(PostMessageToAdminChat(text))
member this.PostVideo(url, savePath, externalId) =
inbox.Post(PostVideo(url, savePath, externalId)) }
[<RequireQualifiedAccess>]
module TgUpdateHandler =
type private Msg =
| NewUpdate of Update
let private createInbox (config: BotConfig) (service: ITgService) (ytService: IYoutubeDlService) =
MailboxProcessor.Start(fun inbox ->
let rec loop() =
async {
match! inbox.Receive() with
| NewUpdate update ->
try
match BotUpdateType.getUpdateType update config with
| BotUpdateType.Skip ->
Logging.logger.Information("Skipping update")
| BotUpdateType.Ping ->
Logging.logger.Information("Received ping")
service.Ping()
| BotUpdateType.YoutubeRepost url ->
Logging.logger.Information("Received youtube repost update")
async {
let! id = ytService.AddJob(url)
service.PostMessageToAdminChat(id.ToString())
} |> Async.Start
| BotUpdateType.RelayUpdate relayArgs ->
Logging.logger.Information("Relay update")
service.PostRelay(relayArgs)
with ex ->
Logging.logger.Error(ex, "Блядь")
try
service.PostMessageToAdminChat "паша сука"
with ex ->
Logging.logger.Error(ex, "Да блядь")
return! loop ()
}
loop()
)
let createHandler config service ytService =
let inbox = createInbox config service ytService
{ new ITgUpdateHandler with
member this.PostUpdate update =
inbox.Post(NewUpdate(update)) }