{-# LANGUAGE OverloadedStrings #-} module Hoovie.Stream ( streamHandler ) where import Control.Monad (when) import Control.Monad.IO.Class (liftIO) import Data.Maybe (fromJust) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC import Snap.Core import Debug.Trace import Hoovie.Transcode import Hoovie.Monitor import Hoovie.Util import Hoovie.Resource streamHandler :: FilePath -> Snap () streamHandler db = do request <- getRequest rid <- getParam "id" resource <- liftIO $ getResourceById db (maybe Nothing maybeReadBS rid) if resource /= Nothing && getHeader "TransferMode.DLNA.org" request == Just "Streaming" then streamResource $ fromJust resource else pass streamResource :: Resource -> Snap () streamResource resource = do request <- getRequest modifyResponse $ setHeader "TransferMode.DLNA.org" "Streaming" . setHeader "Content-Type" "video/mpeg" . setHeader "ContentFeatures.DLNA.ORG" "DLNA.ORG_PN=MPEG_PS_NTSC;DLNA.ORG_OP=10;DLNA.ORG_CI=0;DLNA.ORG_FLAGS=01700000000000000000000000000000" . setHeader "Accept-Ranges" "bytes" . setHeader "Connection" "keep-alive" let timeRange = case getHeader "TimeSeekRange.dlna.org" request of Nothing -> (Nothing, Nothing) Just range -> parseTimeRange range when (rqMethod request == HEAD) $ do modifyResponse $ setContentLength 0 when (rqMethod request == GET) $ do modifyResponse $ setResponseBody (transcode timeRange $ reFilename resource) parseTimeRange :: B.ByteString -> (Maybe Double, Maybe Double) parseTimeRange s = let (start, stop) = BC.break (== '-') $ BC.drop 1 $ BC.dropWhile (/= '=') s in (parseTime start, parseTime $ BC.drop 1 stop) parseTime :: B.ByteString -> Maybe Double parseTime s = trace (show s) $ maybeRead (BC.unpack s)