Add request logger

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 }
 

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 }
  }

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 =
  [<IgnoreDataMember>]

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)
 

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(

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
+
+
 [<EntryPoint>]
 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