http.hs

{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
module Main where

import Network.Wai
import Network.Wai.Handler.Warp
import Network.HTTP.Types
import qualified Data.ByteString.Char8 as B
import Control.Monad.Trans
import System.IO
import Data.List.Split (splitOn)

video = "videos/big_buck_bunny.mp4"

main = do
  total <- liftIO $ withFile video ReadMode hFileSize
  run 3000 $ \Request{..} -> do
        liftIO $ putStrLn "Connection"
        case lookup "Range" requestHeaders of
            Nothing -> do
                return $ ResponseFile ok200 [("Content-Type", "video/mp4"), ("Connection","keep-alive"), ("Content-Length", B.pack $ show total)] video Nothing
            Just r -> do
                let (starts:ends:_) = splitOn "-" $ drop 6 $ B.unpack r
                    start = read starts
                    end = if not (null ends) then read ends else total - 1 -- why -1?
                    offset = start
                    bytecount = end-start
                liftIO $ putStrLn $ "Range request " ++ show start ++ " " ++ show end
                return $ ResponseFile partialContent206 [("Content-Type", "video/mp4")
                                                       , ("Accept-Ranges", "bytes")
                                                       , ("Content-Length", B.pack . show $ (end - start) + 1)
                                                       , ("Content-Range", B.pack $ concat ["bytes ", show start, "-", show end, "/", show total])
                                                       ] video (Just (FilePart offset bytecount))