From 6648e2c685dd83772a5c982b01ee4ad31b92af8a Mon Sep 17 00:00:00 2001 From: Nikolay M Date: Tue, 23 Apr 2024 18:36:20 +0400 Subject: [PATCH] Add request logger (#76) --- src/Funogram.Telegram/Bot.fs | 5 +- src/Funogram/Tools.fs | 121 +++++++++++++++--- src/Funogram/Types.fs | 7 +- .../Funogram.TestBot/Commands/Base.fs | 4 +- .../Funogram.TestBot/Commands/TextMessages.fs | 10 +- src/examples/Funogram.TestBot/Program.fs | 14 ++ 6 files changed, 137 insertions(+), 24 deletions(-) diff --git a/src/Funogram.Telegram/Bot.fs b/src/Funogram.Telegram/Bot.fs index cc10b10..0e01fd9 100644 --- a/src/Funogram.Telegram/Bot.fs +++ b/src/Funogram.Telegram/Bot.fs @@ -25,14 +25,15 @@ module Config = Client = new HttpClient() ApiEndpointUrl = Uri("https://api.telegram.org/bot") WebHook = None - OnError = (fun e -> printfn "%A" e) } + OnError = printfn "%A" + RequestLogger = None } let withReadTokenFromFile config = if File.Exists(TokenFileName) then { config with Token = File.ReadAllText(TokenFileName) } else printf "Please, enter bot token: " - let token = System.Console.ReadLine() + let token = Console.ReadLine() File.WriteAllText(TokenFileName, token) { config with Token = token } diff --git a/src/Funogram/Tools.fs b/src/Funogram/Tools.fs index 00b831e..042700a 100644 --- a/src/Funogram/Tools.fs +++ b/src/Funogram/Tools.fs @@ -1,8 +1,9 @@ module Funogram.Tools open System -open System.Net +open System.IO open System.Net.Http +open System.Net.Http.Headers open System.Runtime.CompilerServices open System.Text open System.Text.Json @@ -14,11 +15,67 @@ open Funogram.Types do () open System.Collections.Concurrent -open System.IO open System.Linq.Expressions open Funogram.Converters open TypeShape.Core +module internal RequestLogger = + type Logger = + { + Text: StringBuilder + Logger: IBotLogger + } + + let createIfRequired (config: BotConfig) = + match config.RequestLogger with + | Some logger when logger.Enabled -> { Text = StringBuilder(); Logger = logger } |> Some + | _ -> None + + let appendReqAsync (url: string) (content: MultipartFormDataContent) (hasData: bool) (logger: Logger) = + task { + let req = if hasData then "POST" else "GET" + let sb = logger.Text.Append("Req: ").Append(req).Append(" ").AppendLine(url) + try + if hasData then + sb.AppendLine("multipart/form-data") |> ignore + for item in content do + sb.Append(item.Headers.ContentDisposition.Name) |> ignore + match item with + | :? StringContent as s -> + let! s = s.ReadAsStringAsync() + sb.Append("=").Append(s).AppendLine() |> ignore + | :? ByteArrayContent as b -> + let fileName = item.Headers.ContentDisposition.FileName + if String.IsNullOrEmpty(fileName) then + let! b = b.ReadAsByteArrayAsync() + let s = Encoding.UTF8.GetString(b) + sb.Append("=").AppendLine(s) |> ignore + else + sb.Append("=[file ").Append(fileName).AppendLine("]") |> ignore + | _ -> () + with | _ -> () + } + + let appendReqJson (url: string) (data: byte[]) (logger: Logger) = + logger.Text + .Append("Req: POST ") + .AppendLine(url) + .AppendLine("application/json") + .AppendLine(Encoding.UTF8.GetString(data)) |> ignore + + + let appendResAndWriteAsync (stream: Stream) (logger: Logger) = + async { + let! data = stream.AsyncRead(int stream.Length) + logger.Text.Append("Res: ").Append(Encoding.UTF8.GetString(data)) |> ignore + stream.Seek(0, SeekOrigin.Begin) |> ignore + logger.Logger.Log(logger.Text.ToString()) + } + + let appendResExceptionAndWrite (e: exn) (logger: Logger) = + logger.Text.Append("Res: ").Append(e.ToString()) |> ignore + logger.Logger.Log(logger.Text.ToString()) + let internal options = let o = JsonSerializerOptions( @@ -422,29 +479,55 @@ module Api = use content = new MultipartFormDataContent() let hasData = serialize request content - - let! result = - if hasData then client.PostAsync(url, content) |> Async.AwaitTask - else client.GetAsync(url) |> Async.AwaitTask - - if result.StatusCode = HttpStatusCode.OK then + + let logger = RequestLogger.createIfRequired config + match logger with + | Some logger -> do! logger |> RequestLogger.appendReqAsync url content hasData |> Async.AwaitTask + | _ -> () + + let mutable statusCode = -1 + try + let! result = + if hasData then client.PostAsync(url, content) |> Async.AwaitTask + else client.GetAsync(url) |> Async.AwaitTask + + statusCode <- result.StatusCode |> int + use! stream = result.Content.ReadAsStreamAsync() |> Async.AwaitTask + match logger with + | Some logger -> do! logger |> RequestLogger.appendResAndWriteAsync stream + | _ -> () return parseJsonStreamApiResponse<'a> stream - else - return Error { Description = "HTTP_ERROR"; ErrorCode = int result.StatusCode } + with + | e -> + logger |> Option.iter (RequestLogger.appendResExceptionAndWrite e) + return Error { Description = "HTTP_ERROR"; ErrorCode = statusCode } } - let makeJsonBodyRequestAsync config (request: IRequestBase<'a>) = + let makeJsonBodyRequestAsync<'a, 'b when 'a :> IRequestBase<'b>> config (request: 'a) = async { let client = config.Client let url = getUrl config request.MethodName - use ms = new MemoryStream() - JsonSerializer.Serialize(ms, request, options) - - use content = new StreamContent(ms) - let! result = client.PostAsync(url, content) |> Async.AwaitTask - - use! stream = result.Content.ReadAsStreamAsync() |> Async.AwaitTask - return parseJsonStreamApiResponse<'a> stream + let logger = RequestLogger.createIfRequired config + + let bytes = JsonSerializer.SerializeToUtf8Bytes(request, options) + logger |> Option.iter (RequestLogger.appendReqJson url bytes) + + let mutable statusCode = -1 + try + use content = new ByteArrayContent(bytes) + content.Headers.ContentType <- MediaTypeHeaderValue.Parse("application/json") + let! result = client.PostAsync(url, content) |> Async.AwaitTask + statusCode <- result.StatusCode |> int + + use! stream = result.Content.ReadAsStreamAsync() |> Async.AwaitTask + match logger with + | Some logger -> do! logger |> RequestLogger.appendResAndWriteAsync stream + | _ -> () + return parseJsonStreamApiResponse<'a> stream + with + | e -> + logger |> Option.iter (RequestLogger.appendResExceptionAndWrite e) + return Error { Description = "HTTP_ERROR"; ErrorCode = statusCode } } \ No newline at end of file diff --git a/src/Funogram/Types.fs b/src/Funogram/Types.fs index b83b261..aacc197 100644 --- a/src/Funogram/Types.fs +++ b/src/Funogram/Types.fs @@ -7,6 +7,10 @@ open System.Net type BotWebHook = { Listener: HttpListener; ValidateRequest: HttpListenerRequest -> bool } +type IBotLogger = + abstract member Log: message: string -> unit + abstract member Enabled: bool + type BotConfig = { IsTest: bool Token: string @@ -17,7 +21,8 @@ type BotConfig = OnError: Exception -> unit ApiEndpointUrl: Uri Client: HttpClient - WebHook: BotWebHook option } + WebHook: BotWebHook option + RequestLogger: IBotLogger option } type IBotRequest = [] diff --git a/src/examples/Funogram.TestBot/Commands/Base.fs b/src/examples/Funogram.TestBot/Commands/Base.fs index 1ac9343..0775411 100644 --- a/src/examples/Funogram.TestBot/Commands/Base.fs +++ b/src/examples/Funogram.TestBot/Commands/Base.fs @@ -16,6 +16,7 @@ let defaultText = """⭐️Available test commands: /send_message8 - Test multiple media /send_message9 - Test multiple media as bytes /send_message10 - MarkdownV2 test + /send_message11 - MarkdownV2 test (json body) /send_action - Test action @@ -47,7 +48,8 @@ let updateArrived (ctx: UpdateContext) = cmd "/send_message8" (fun _ -> Files.testUploadAndSendPhotoGroup |> wrap) cmd "/send_message9" (fun _ -> Files.testUploadAndSendPhotoGroupAsBytes |> wrap) - cmd "/send_message10" (fun _ -> TextMessages.testMarkdownV2 |> wrap) + cmd "/send_message10" (fun _ -> TextMessages.testMarkdownV2 false |> wrap) + cmd "/send_message11" (fun _ -> TextMessages.testMarkdownV2 true |> wrap) cmd "/forward_message" (fun _ -> TextMessages.testForwardMessage ctx |> wrap) diff --git a/src/examples/Funogram.TestBot/Commands/TextMessages.fs b/src/examples/Funogram.TestBot/Commands/TextMessages.fs index 31265a1..3a77b04 100644 --- a/src/examples/Funogram.TestBot/Commands/TextMessages.fs +++ b/src/examples/Funogram.TestBot/Commands/TextMessages.fs @@ -4,6 +4,7 @@ open Funogram.Telegram open Funogram.Telegram.Bot open Funogram.TestBot.Core open Funogram.Telegram.Types +open Funogram.Tools let private sendMessageFormatted text parseMode config chatId = Req.SendMessage.Make(ChatId.Int chatId, text, parseMode = parseMode) |> bot config @@ -62,7 +63,14 @@ let HtmlExample = """ """ let testMarkdown = sendMessageFormatted MarkdownExample ParseMode.Markdown -let testMarkdownV2 = sendMessageFormatted MarkdownV2Example ParseMode.MarkdownV2 +let testMarkdownV2 jsonBody config chatId = + if jsonBody then + Req.SendMessage.Make(ChatId.Int chatId, MarkdownV2Example, parseMode = ParseMode.MarkdownV2) + |> Api.makeJsonBodyRequestAsync config + |> Async.Ignore + |> Async.Start + else + sendMessageFormatted MarkdownV2Example ParseMode.MarkdownV2 config chatId let testHtml = sendMessageFormatted HtmlExample ParseMode.HTML let testNoWebpageAndNotification config chatId = Req.SendMessage.Make( diff --git a/src/examples/Funogram.TestBot/Program.fs b/src/examples/Funogram.TestBot/Program.fs index 1744f38..e3da8a4 100644 --- a/src/examples/Funogram.TestBot/Program.fs +++ b/src/examples/Funogram.TestBot/Program.fs @@ -1,14 +1,28 @@ module Funogram.TestBot.Program +open System open Funogram.TestBot open Funogram.Api open Funogram.Telegram open Funogram.Telegram.Bot +type ConsoleLogger(color: ConsoleColor) = + interface Funogram.Types.IBotLogger with + member x.Log(text) = + let fc = Console.ForegroundColor + Console.ForegroundColor <- color + Console.WriteLine(text) + Console.ForegroundColor <- fc + member x.Enabled = true + + [] let main _ = async { let config = Config.defaultConfig |> Config.withReadTokenFromFile + let config = + { config with + RequestLogger = Some (ConsoleLogger(ConsoleColor.Green)) } let! _ = Api.deleteWebhookBase () |> api config return! startBot config Commands.Base.updateArrived None } |> Async.RunSynchronously