Is there a way to pipe an image directly to a suave response stream?

Question

I want to dynamically generate an image on server side and send it to the browser.

Currently I'm using a MemoryStream to convert it to byte array and then usual suave api. See bellow:

let draw (text:string) =

  let redBr = new SolidBrush(Color.Red)
  let whiteBr = new SolidBrush(Color.White)
  let i = new Bitmap(600,400)
  let g = Graphics.FromImage i
  let f = new Font("Courier", float32 <| 24.0)
  g.FillRectangle(whiteBr, float32 <| 0.0, float32 <| 0.0, float32 <| 600.0, float32 <| 400.0 )
  g.DrawString(text, f, redBr, float32 <| 10.0, float32 <| 40.0)
  g.Flush()
  let ms = new System.IO.MemoryStream()
  i.Save(ms, ImageFormat.Png)
  ms.ToArray()

let app : WebPart =
  Writers.setMimeType "image/png"
  >=> (Successful.ok <| draw "bibi")

I feel that the MemoryStream part can be avoided if suave is allowing us to pipe directly to the response stream.

Thanks!

Answer 1

You basically do this:

open System.IO
open Suave
open Suave.Sockets
open Suave.Sockets.Control

path "/byte-stream" >=> (fun ctx ->

  let write (conn, _) = socket {
    use ms = new MemoryStream()
    ms.Write([| 1uy; 2uy; 3uy |], 0, 3)
    ms.Seek(0L, SeekOrigin.Begin) |> ignore
    // do things here
    let! (_,conn) = asyncWriteLn (sprintf "Content-Length: %d\r\n" ms.Length) conn
    let! conn = flush conn
    do! transferStream conn ms
    return conn
  }

  { ctx with
      response =
        { ctx.response with
            status = HTTP_200.status
            content = SocketTask write } }
  |> succeed
)

Answer 2

I assume you are concerned about allocating an unnecessary object. I think such concern is commendable.

What you are probably after is an Bitmap API where the bytes of the PNG image is provided through Stream<byte> and the Bitmap API then produces when needed by the socket.

System.Drawing doesn't seem to support such behavior, possibly WIC does (.NET wrappers exists through the excellent SharpDX library).

However, this would mean keeping potentially expensive objects (bitmap, brushes and so on) alive for the duration of the transfer. The byte array might be a more efficient way to store the result.

Another approach in order to avoid allocating objects unnecessarily is caching them. It's made a bit more problematic because System.Drawing objects are mutable and not safe to use from multiple threads. You can however create a cache per thread using ThreadLocal.

In the sample code below most objects are cached per Thread. The only object created per call to draw is the byte array returned but that is probably an efficient storage of the PNG data (it's possible the calls System.Drawing allocates objects but we have no control over that). As I didn't figure out a way to listen for the "death" of a Thread it means it's important to manually dispose the objects using the dispose method when the Thread no longer needs the objects.

Hope this was interesting

open System
open System.Drawing
open System.Drawing.Imaging
open System.IO
open System.Threading

module BitmapCreator =
  module internal Details =
    let dispose (d : IDisposable) =
      if d <> null then
        try
          d.Dispose ()
        with
        | e -> () // TODO: log

    // state is ThreadLocal, it means the resources gets initialized once per thread
    let state =
      let initializer () =
        // Allocate all objects needed for work
        let font        = new Font("Courier", 24.0F)
        let red         = new SolidBrush(Color.Red)
        let white       = new SolidBrush(Color.White)
        let bitmap      = new Bitmap(600,400)
        let g           = Graphics.FromImage bitmap
        let ms          = new MemoryStream 1024
        // disposer should be called when Thread is terminating to reclaim
        //  resources as fast as possible
        let disposer () =
          dispose ms
          dispose g
          dispose bitmap
          dispose white
          dispose red
          dispose font
        font, red, white, bitmap, g, ms, disposer

      new ThreadLocal<_>(initializer)

  // Draws text on a bitmap and returns that as a byte array
  let draw text =
    // Grab the state for the current thread
    let font, red, white, bitmap, g, ms, _ = Details.state.Value

    g.FillRectangle(white, 0.0F, 0.0F, 600.0F, 400.0F)
    g.DrawString(text, font, red, 10.0F, 40.0F)
    g.Flush()

    // Resets the memory stream
    //  The capacity is preserved meaning as long as the generated
    //  images is equal or smaller in size no realloc is needed
    ms.Seek (0L, SeekOrigin.Begin) |> ignore
    ms.SetLength 0L

    bitmap.Save(ms, ImageFormat.Png)

    // Here a new array is allocated per call
    //  Depending on how FillRectangle/DrawString works this is hopefully our
    //  only allocation
    ms.ToArray()

  // Disposes all BitmapCreator resources held by the current thread
  let dispose () =
    let _, _, _, _, _, _, disposer = Details.state.Value
    disposer ()

[<EntryPoint>]
let main argv =
  // Saves some bitmaps to file, the name include the thread pid in order
  //  to not overwrite other threads' images
  let save () =
    let texts = [|"Hello"; "There"|]
    let tid   = Thread.CurrentThread.ManagedThreadId
    for text in texts do
      File.WriteAllBytes (sprintf "%s_%d.png" text tid, BitmapCreator.draw text)

  // Runs a in other thread, disposes BitmapCreator resources when done
  let runInOtherThread (a : unit -> unit) =
    let a () =
      try
        a ()
      finally
        BitmapCreator.dispose ()
    let thread = Thread a
    thread.Start ()
    thread.Join ()

  Environment.CurrentDirectory <- AppDomain.CurrentDomain.BaseDirectory

  try
    save () // Here we allocate BitmapCreator resources
    save () // Since the same thread is calling the resources will reused
    runInOtherThread save // New thread, new resources
    runInOtherThread save // New thread, new resources
  finally
    BitmapCreator.dispose ()

  0