Add request logger (#76)

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