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