A webcam server in 35 lines of Haskell

See also : vidéo peertube - vidéo youtube - dépôt git - article linuxfr.org

This post shows how to implement a webcam server in Haskell. The implemented server is a classic web server that stores the current image in memory and sends it to any HTTP client that requests it. The current image is updated in parallel, from the video stream of the webcam.

Video capture

First, we need to open and capture the video stream of the webcam. This can be done easily using OpenCV, a classic computer vision library. OpenCV is implemented in C++ but it has many wrappers, including a Haskell wrapper: haskell-opencv.

In the following code, the openCam function opens the first video device (id 0) and sets its frame rate at 5 FPS. Then, the captureCam function reads an OpenCV image (type Mat ('S ['D, 'D]) 'D 'D) from a video device (type VideoCapture). Finally, the imgToPng function converts an OpenCV image to a PNG image that can be displayed by a web browser.

{-# language DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}

import Control.Concurrent (forkIO)
import Control.Monad (forever, unless, liftM)
import Data.ByteString (ByteString)
import Data.ByteString.Lazy (fromStrict)
import Data.IORef (atomicWriteIORef, IORef, newIORef, readIORef)
import qualified Web.Scotty as SC

import OpenCV
import OpenCV.VideoIO.Types

openCam :: IO (Maybe VideoCapture)
openCam = do
    cap <- newVideoCapture
    exceptErrorIO $ videoCaptureOpen cap $ VideoDeviceSource 0 Nothing
    isOpened <- videoCaptureIsOpened cap
    case isOpened of
        False -> return Nothing
        True -> videoCaptureSetD cap VideoCapPropFps 5 >> (return $ Just cap)

captureCam :: VideoCapture -> IO (Maybe (Mat ('S ['D, 'D]) 'D 'D))
captureCam cap = videoCaptureGrab cap >> videoCaptureRetrieve cap 

imgToPng :: Mat ('S ['D, 'D]) 'D 'D -> ByteString
imgToPng = exceptError . imencode (OutputPng defaultPngParams)

We can test these functions locally, with the following code. The loopCam function reads an image (using captureCam), displays this image in a window then loops recursively unless the “esc” key is pressed. The main function simply opens a video device (with openCam), creates a window and launches the loopCam recursion.

main :: IO ()
main = do
    capMaybe <- openCam
    case capMaybe of
        Nothing -> putStrLn "couldn't open device"
        Just cap -> withWindow "webcamer" (loopCam cap)

loopCam :: VideoCapture -> Window -> IO ()
loopCam cap window = do
    imgMaybe <- captureCam cap
    case imgMaybe of
        Nothing -> return ()
        Just img -> do
            imshow window img
            key <- waitKey 20
            unless (key == 27) $ loopCam cap window

If you run this code, you should see a window showing the video stream of your webcam, at 5 FPS.

Web server

Now let’s serve our video stream through a web server, using the scotty web framework. Instead of the previous main and loopCam functions, the main function now opens the video device then runs runServer. The runServer function runs a scotty server that serves two routes. For the route “/”, it serves the home page (i.e., the file index.html). For the route “/out.png”, it reads an image from the webcam, converts this image to PNG format then sends it to the HTTP client.

main :: IO ()
main = do
    capMaybe <- openCam
    case capMaybe of
        Nothing -> putStrLn "couldn't open device"
        Just cap -> runServer 3042 cap

runServer :: Int -> VideoCapture -> IO ()
runServer port cap = SC.scotty port $ do
    SC.get "/" $ SC.file "index.html"
    SC.get "/out.png" $ do
        SC.setHeader "Content-Type" "image/png"
        imgMaybe <- SC.liftAndCatchIO $ liftM imgToPng <$> captureCam cap
        case imgMaybe of
            Nothing -> return ()
            Just img -> SC.raw $ fromStrict img

This web server sends an image when a client requests it. To really display the video stream, the client has to request an image regularly. This is done in the following index.html page. The updateImg function requests the “out.png” route to the server and updates the HTML page when the image is received from the server. This function is called every 200 ms (i.e., at 5 FPS), thanks to setInterval.

<!DOCTYPE html>
<html>
    <head>
        <meta charset="utf-8"/>
    </head>
    <body>
        <h1>webcamer</h1>
        <img id="my_img"> </img>
        <script>
            function updateImg() {
                fetch("out.png")
                    .then(response => response.blob())
                    .then(function(myBlob){
                        URL.revokeObjectURL(my_img.src);
                        my_img.src = URL.createObjectURL(myBlob);
                    });
            }
            const my_interval = setInterval(updateImg, 200);
        </script>
    </body>
</html>

Handling multiple connections

The previous web server reads an image when a client requests the “out.png” route. However, this doesn’t work for multiple clients because the video stream can’t provide enough images. To solve this problem, we can read the video stream and handle the HTTP requests independently.

The following code uses a mutable reference IORef to store the current image. This image is read in the runServer function when a HTTP client requests it, and it is updated in the runCam function when a new image is available from the video stream. Finally, the main function initializes the mutable reference and runs runServer and runCam in parallel, using forkIO (lightweight threads).

main :: IO ()
main = do
    capMaybe <- openCam
    case capMaybe of
        Nothing -> putStrLn "couldn't open device"
        Just cap -> do
            Just png0 <- liftM imgToPng <$> captureCam cap
            pngRef <- newIORef png0
            _ <- forkIO $ runCam cap pngRef
            runServer 3042 pngRef

runServer :: Int -> IORef ByteString -> IO ()
runServer port pngRef = SC.scotty port $ do
    SC.get "/" $ SC.file "index.html"
    SC.get "/out.png" $ do
        SC.setHeader "Content-Type" "image/png"
        img <- SC.liftAndCatchIO (readIORef pngRef) 
        SC.raw $ fromStrict img

runCam :: VideoCapture -> IORef ByteString -> IO ()
runCam cap pngRef = forever $ do
    imgMaybe <- liftM imgToPng <$> captureCam cap
    mapM_ (atomicWriteIORef pngRef) imgMaybe

Thus, if several HTTP clients request an image but only one image is available in the video stream, the server sends the same image to all clients.

Putting everything together

The final code of the server is given below. This code handles webcam capture, web service and multiple clients. And it’s only 35 lines of Haskell.

{-# LANGUAGE OverloadedStrings #-}

import Control.Concurrent (forkIO)
import Control.Monad (forever, liftM)
import Data.ByteString.Lazy (fromStrict)
import Data.IORef (atomicWriteIORef, newIORef, readIORef)
import Web.Scotty (get, file, raw, scotty, liftAndCatchIO, setHeader)
import OpenCV
import OpenCV.VideoIO.Types

main = do
    capMaybe <- openCam
    case capMaybe of
        Nothing -> putStrLn "couldn't open device"
        Just cap -> do
            Just png0 <- liftM imgToPng <$> captureCam cap
            pngRef <- newIORef png0
            _ <- forkIO $ runCam cap pngRef
            runServer 3042 pngRef

runServer port pngRef = scotty port $ do
    get "/" $ file "index.html"
    get "/out.png" $ do
        setHeader "Content-Type" "image/png"
        img <- liftAndCatchIO (readIORef pngRef) 
        raw $ fromStrict img

runCam cap pngRef = forever $ do
    imgMaybe <- liftM imgToPng <$> captureCam cap
    mapM_ (atomicWriteIORef pngRef) imgMaybe

openCam = do
    cap <- newVideoCapture
    exceptErrorIO $ videoCaptureOpen cap $ VideoDeviceSource 0 Nothing
    isOpened <- videoCaptureIsOpened cap
    case isOpened of
        False -> return Nothing
        True -> videoCaptureSetD cap VideoCapPropFps 5 >> (return $ Just cap)

captureCam cap = videoCaptureGrab cap >> videoCaptureRetrieve cap 

imgToPng = exceptError . imencode (OutputPng defaultPngParams)