vidéo peertube - vidéo youtube - dépôt git - article linuxfr.org
A webcam server in 35 lines of Haskell
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)