module Cook.Util where import Cook.Types import Control.Monad import Control.Monad.Trans import Control.Retry import Data.List (intercalate) import System.Exit import System.IO import System.Log.Formatter import System.Log.Handler hiding (setLevel) import System.Log.Handler.Simple import System.Log.Logger import System.Process (system, rawSystem, readProcessWithExitCode) import qualified Crypto.Hash.SHA1 as SHA1 import qualified Data.ByteString as BS quickHash :: [BS.ByteString] -> SHA1 quickHash bsList = SHA1 $ SHA1.finalize (SHA1.updates SHA1.init bsList) concatHash :: [SHA1] -> SHA1 concatHash sha1List = quickHash $ map unSha1 sha1List initLoggingFramework :: Priority -> IO () initLoggingFramework prio = do myStreamHandler <- streamHandler stdout prio let myStreamHandler' = setFormatter myStreamHandler (simpleLogFormatter "[$prio $time $loggername] $msg") root <- getRootLogger saveGlobalLogger (setLevel DEBUG $ setHandlers [myStreamHandler'] root) logInfo :: MonadIO m => String -> m () logInfo = liftIO . infoM "cook" logDebug :: MonadIO m => String -> m () logDebug = liftIO . debugM "cook" logWarn :: MonadIO m => String -> m () logWarn = liftIO . warningM "cook" logError :: MonadIO m => String -> m () logError = liftIO . errorM "cook" readProcessWithExitCode' :: String -> [String] -> String -> IO (ExitCode, String, String) readProcessWithExitCode' cmd args procIn = do logDebug ("$ " ++ cmd ++ " " ++ intercalate " " args) readProcessWithExitCode cmd args procIn systemStream :: Maybe FilePath -> String -> (BS.ByteString -> IO ()) -> IO ExitCode systemStream mDir cmd _onOutput = let realCmd = case mDir of Just dir -> "(cd " ++ dir ++ "; " ++ cmd ++ ")" Nothing -> cmd in do logDebug ("$ " ++ realCmd) system realCmd compressFilesInDir :: Bool -> FilePath -> FilePath -> [FilePath] -> IO () compressFilesInDir shouldRetry tarName dirFp files = do ecTar <- retrying (constantDelay microsec <> limitRetries 5) checkRetry sysAction unless (ecTar == ExitSuccess) $ fail ("Error creating tar:\n" ++ tarCmd ++ " " ++ unwords tarArgs) where microsec = 12 * 1000 * 1000 checkRetry _ ec = return (shouldRetry && ec /= ExitSuccess) sysAction = rawSystem tarCmd tarArgs tarCmd = "/usr/bin/env" tarArgs = ["tar", "cjf", tarName, "-C", dirFp] ++ files