Stream a file as it is created (such as a video)

http-stream-file.hs

module Main (main) where

import Control.Monad (forever, when)
import System.Environment (getArgs)
import System.IO (withBinaryFile, hIsEOF, IOMode(ReadMode), hSetBuffering, BufferMode(BlockBuffering))
import Control.Concurrent (threadDelay)
import Blaze.ByteString.Builder.ByteString (fromByteString)
import Data.ByteString (ByteString)
import Data.ByteString as BS
import Data.Text as T
import Data.Text.Encoding as T

import Network.Wai
import Network.Wai.Handler.Warp (run)
import Network.HTTP.Types.Header (hContentType)
import Network.HTTP.Types.Status (status200)

chunkSize :: Int
chunkSize = 4000

delay :: Int
delay = 2000000

app :: FilePath -> ByteString -> Application
app path mime req respond = withBinaryFile path ReadMode $ \file -> do
	hSetBuffering file (BlockBuffering $ Just chunkSize)
	respond $ responseStream status200 [(hContentType, mime)] $ \write flush -> forever $ do
		write . fromByteString =<< BS.hGetSome file chunkSize
		flush
		flip when (threadDelay delay) =<< hIsEOF file

main :: IO ()
main = do
	[port, path, mime] <- getArgs
	run (read port) (app path $ T.encodeUtf8 $ T.pack mime)