Stream.hs

{-# 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)