1 {-# LANGUAGE OverloadedStrings #-} 2 module Databrary.Store.Probe 3 ( Probe(..) 4 , probeLength 5 , probeFile 6 , probeAutoPosition 7 , avProbeCheckFormat 8 ) where 9 10 import Control.Arrow (left) 11 import Control.Exception (try) 12 import Control.Monad.IO.Class (MonadIO(..)) 13 import Control.Monad.Trans.Except (ExceptT(..), runExceptT, throwE) 14 import qualified Data.ByteString as BS 15 import Data.List (isPrefixOf) 16 import Data.Monoid ((<>)) 17 import qualified Data.Text as T 18 import qualified Data.Text.Encoding as TE 19 import Data.Time.Calendar (diffDays) 20 import Data.Time.LocalTime (ZonedTime(..), LocalTime(..), timeOfDayToTime) 21 import System.Posix.FilePath (takeExtension) 22 23 import Databrary.Has 24 import Databrary.Files 25 import Databrary.Service.DB 26 import Databrary.Model.Format 27 import Databrary.Model.Offset 28 import Databrary.Model.Container.Types 29 import Databrary.Model.AssetSlot 30 import Databrary.Store.AV 31 -- import Databrary.Action.Types 32 33 data Probe 34 = ProbePlain 35 { probeFormat :: Format } 36 | ProbeAV 37 { probeFormat :: Format 38 , probeTranscode :: Format 39 , probeAV :: AVProbe 40 } 41 42 -- | Get detected length if this is an audio or video file 43 probeLength :: Probe -> Maybe Offset 44 probeLength ProbeAV{ probeAV = av } = avProbeLength av 45 probeLength _ = Nothing 46 47 -- | Detect whether the mimetype expected in the file given is accepted by Databrary, 48 -- and probe/wrap the file into a Probe describing it conversion target and current format. 49 probeFile :: (MonadIO m, MonadHas AV c m) => BS.ByteString -> RawFilePath -> m (Either T.Text Probe) 50 probeFile n f = runExceptT $ maybe 51 (throwE $ "unknown or unsupported format: " <> TE.decodeLatin1 (takeExtension n)) 52 (\fmt -> case formatTranscodable fmt of 53 Nothing -> return $ ProbePlain fmt 54 Just t 55 | t == videoFormat || t == audioFormat -> do 56 av <- ExceptT $ left (("could not process unsupported or corrupt media file: " <>) . T.pack . avErrorString) 57 <$> focusIO (try . avProbe f) 58 if avProbeHas AVMediaTypeVideo av 59 then return $ ProbeAV fmt videoFormat av 60 else if avProbeHas AVMediaTypeAudio av 61 then return $ ProbeAV fmt audioFormat av 62 else throwE "no supported video or audio content found" 63 | otherwise -> fail "unhandled format conversion") 64 $ getFormatByFilename n 65 66 -- TODO: make this pure 67 probeAutoPosition :: MonadDB c m => Container -> Maybe Probe -> m Offset 68 probeAutoPosition 69 Container{ containerRow = ContainerRow { containerDate = Just d } } 70 (Just ProbeAV{ probeAV = AVProbe{ avProbeDate = Just (ZonedTime (LocalTime d' t) _) } }) 71 | dd >= -1 && dd <= 1 && dt >= negate day2 && dt <= 3*day2 = 72 return $ diffTimeOffset dt 73 where 74 dd = diffDays d' d 75 dt = (fromInteger dd)*day + timeOfDayToTime t 76 day2 = 43200 77 day = 2*day2 78 probeAutoPosition c _ = findAssetContainerEnd c 79 80 -- |Test if this represents a file in standard format. 81 avProbeCheckFormat :: Format -> AVProbe -> Bool 82 avProbeCheckFormat fmt AVProbe{ avProbeFormat = "mov,mp4,m4a,3gp,3g2,mj2", avProbeStreams = ((AVMediaTypeVideo,"h264"):s) } 83 -- Note: isPrefixOf use here is terse/counterinteruitive. should explicitly test for empty list 84 | fmt == videoFormat = s `isPrefixOf` [(AVMediaTypeAudio,"aac")] 85 avProbeCheckFormat fmt AVProbe{ avProbeFormat = "mp3", avProbeStreams = ((AVMediaTypeAudio,"mp3"):_) } 86 | fmt == audioFormat = True 87 avProbeCheckFormat _ _ = False 88