1 {-# LANGUAGE OverloadedStrings #-} 2 {-# LANGUAGE RecordWildCards #-} 3 module Store.Transcoder 4 ( runTranscoder 5 , initTranscoder 6 , transcodeEnabled 7 ) where 8 9 import Data.Maybe (isJust) 10 import Data.Version (showVersion) 11 import System.Process (readProcessWithExitCode) 12 import System.Exit (ExitCode(..)) 13 14 import Paths_databrary (version, getDataFileName) 15 import Store.Types 16 17 runTranscoder :: Transcoder -> [String] -> IO (ExitCode, String, String) 18 runTranscoder (Transcoder cmd arg _) args = 19 readProcessWithExitCode cmd (arg ++ args) "" 20 21 -- | Ensures the configured transcoder works, returning it as a capability. Will 22 -- throw a synchronous exception if the transcoder can't be run. 23 initTranscoder :: TranscoderConfig -> IO (Maybe Transcoder) 24 initTranscoder tconf@TranscoderConfig {..} = case (transcoderHost, transcoderDir) of 25 (Nothing, Nothing) -> return Nothing 26 _ -> Just <$> do 27 cmd <- getDataFileName "transctl.sh" 28 let t = 29 Transcoder cmd 30 (["-v", showVersion version] 31 ++ maybe [] (\d -> ["-d", d]) transcoderDir 32 ++ maybe [] (\h -> ["-h", h]) transcoderHost 33 ++ maybe [] (\m -> ["-m", m]) transcoderMount 34 ) 35 tconf 36 (r, out, err) <- runTranscoder t ["-t"] 37 case r of 38 ExitSuccess -> return t 39 ExitFailure e -> 40 fail 41 ("initTranscoder test: " 42 ++ show e 43 ++ "\n=== STDOUT ===\n" 44 ++ out 45 ++ "\n=== STDERR ===\n" 46 ++ err) 47 48 transcodeEnabled :: Storage -> Bool 49 transcodeEnabled = isJust . storageTranscoder