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