diff --git a/handsy.cabal b/handsy.cabal --- a/handsy.cabal +++ b/handsy.cabal @@ -1,5 +1,5 @@ name: handsy -version: 0.0.8 +version: 0.0.9 synopsis: A DSL to describe common shell operations and interpeters for running them locally and remotely. -- description: Homepage: https://github.com/utdemir/handsy diff --git a/src/System/Handsy.hs b/src/System/Handsy.hs --- a/src/System/Handsy.hs +++ b/src/System/Handsy.hs @@ -2,24 +2,41 @@ {-# LANGUAGE OverloadedStrings #-} module System.Handsy - ( module System.Handsy - , Handsy - , Options + ( Handsy + , run + + -- * Commands + , command + , readFile + , writeFile + , appendFile + , shell + + -- * Helpers + , command_ + , shell_ + + -- * Options + , Options (..) , options - , debug + + -- * Re-exports + , ExitCode (..) ) where +import Prelude hiding (appendFile, readFile, + writeFile) + import qualified Data.ByteString.Lazy as B import qualified Data.ByteString.Lazy.Char8 as C import System.Exit -import Control.Monad.Trans.Free import System.Process.ByteString.Lazy import System.Handsy.Core hiding (command) import qualified System.Handsy.Core as I --- * Actions +-- * Commands -- | Runs a command command :: FilePath -- ^ Command to run @@ -37,16 +54,14 @@ -- | @writeFile file str@ function writes the bytestring @str@, to the file @file@. writeFile :: FilePath -> B.ByteString -> Handsy () writeFile fp s = command "dd" ["of=" ++ fp] s >>= \case - (ExitSuccess, stdin, _) -> return () - _ -> error $ "Error writing to " ++ fp + (ExitSuccess, _, _) -> return () + _ -> error $ "Error writing to " ++ fp -- | @appendFile file str@ function appends the bytestring @str@, to the file @file@. appendFile :: FilePath -> B.ByteString -> Handsy () appendFile fp s = command "dd" ["of=" ++ fp, "conv=notrunc", "oflag=append"] s >>= \case - (ExitSuccess, stdin, _) -> return () - _ -> error $ "Error appending to " ++ fp - --- * Helpers + (ExitSuccess, _, _) -> return () + _ -> error $ "Error appending to " ++ fp {-| Executes the given string in shell @@ -55,23 +70,22 @@ shell :: String -- ^ String to execute -> B.ByteString -- ^ Standart input -> Handsy (ExitCode, B.ByteString, B.ByteString) -- ^ (ExitCode, Stdout, Stderr) -shell cmd stdin = command "/usr/bin/env" ["sh", "-c", cmd] stdin - --- | Same as 'shell', but ExitFailure is a runtime error. -shell_ :: String -> B.ByteString -> Handsy (B.ByteString, B.ByteString) -shell_ cmd stdin = shell cmd stdin >>= \case - (ExitFailure code, _, stderr) -> error ('`':cmd ++ "` returned " ++ show code - ++ "\nStderr was: " ++ (C.unpack stderr)) - (ExitSuccess, stdout, stderr) -> return (stdout, stderr) +shell cmd = command "sh" ["-c", cmd] -- | Same as 'command', but ExitFailure is a runtime error. command_ :: FilePath -> [String] -> B.ByteString -> Handsy (B.ByteString, B.ByteString) command_ path args stdin = command path args stdin >>= \case - (ExitFailure code, _, stderr) -> error ('`':path ++ ' ' :(show args) ++ "` returned " ++ show code - ++ "\nStderr was: " ++ (C.unpack stderr)) + (ExitFailure code, _, stderr) -> error ('`':path ++ ' ' : show args ++ "` returned " ++ show code + ++ "\nStderr was: " ++ C.unpack stderr) (ExitSuccess, stdout, stderr) -> return (stdout, stderr) --- * Interpreter +-- | Same as 'shell', but ExitFailure is a runtime error. +shell_ :: String -> B.ByteString -> Handsy (B.ByteString, B.ByteString) +shell_ cmd stdin = shell cmd stdin >>= \case + (ExitFailure code, _, stderr) -> error ('`':cmd ++ "` returned " ++ show code + ++ "\nStderr was: " ++ C.unpack stderr) + (ExitSuccess, stdout, stderr) -> return (stdout, stderr) +-- | Executes the actions locally run :: Options -> Handsy a -> IO a run = interpretSimple readProcessWithExitCode diff --git a/src/System/Handsy/Core.hs b/src/System/Handsy/Core.hs --- a/src/System/Handsy/Core.hs +++ b/src/System/Handsy/Core.hs @@ -7,9 +7,8 @@ , interpret , interpretSimple , command - , Options + , Options (..) , options - , debug ) where import Control.Exception (bracket) @@ -18,7 +17,7 @@ import Control.Monad.Trans.Free import qualified Data.ByteString.Lazy as B import System.Exit -import System.IO +import System.IO (hPutStrLn, stderr) data HandsyF k = Command FilePath [String] B.ByteString ((ExitCode, B.ByteString, B.ByteString) -> k) @@ -26,14 +25,16 @@ makeFree ''HandsyF +-- | Main monad type Handsy = FreeT HandsyF IO data Options = Options { debug :: Bool -- ^ Log commands to stderr before running } +-- | Default options options :: Options -options = Options True +options = Options False interpret :: IO r -- ^ Acquire resource -> (r -> IO ()) -- ^ Release resource @@ -42,14 +43,14 @@ -> Options -> Handsy a -> IO a -interpret acquire destroy f opts handsy = bracket acquire destroy (flip go handsy) +interpret acquire destroy f opts handsy = bracket acquire destroy (`go` handsy) where go res h = do x <- runFreeT h case x of Pure r -> return r Free (Command prg args stdin next) -> when (debug opts) (hPutStrLn stderr $ prg ++ ' ' : show args) - >> f res prg args stdin >>= (go res) . next + >> f res prg args stdin >>= go res . next interpretSimple :: (String -> [String] -> B.ByteString -> IO (ExitCode, B.ByteString, B.ByteString)) -- ^ 'readProcessWithExitCode' diff --git a/src/System/Handsy/Remote.hs b/src/System/Handsy/Remote.hs --- a/src/System/Handsy/Remote.hs +++ b/src/System/Handsy/Remote.hs @@ -1,24 +1,23 @@ {-# LANGUAGE OverloadedStrings #-} + module System.Handsy.Remote where -import Prelude hiding (appendFile, readFile, - writeFile) +import Prelude hiding (appendFile, readFile, writeFile) import System.Handsy -import System.Handsy.Core (interpretSimple) +import System.Handsy.Core (interpretSimple) -import qualified Data.ByteString.Char8 as C8 -import qualified Data.ByteString.Lazy as B -import System.Exit +import qualified Data.ByteString.Char8 as C8 +import qualified Data.ByteString.Lazy as B import Control.Monad.IO.Class -import Control.Monad.Trans.Free import Text.ShellEscape data RemoteOptions = RemoteOptions { - sshCommand :: (String, [String]) + -- | Path of `ssh` command and command line arguments + sshCommand :: (FilePath, [String]) } -- | Executes the actions at a remote host diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -3,36 +3,65 @@ module Main where import System.Handsy as H +import System.Handsy.Remote as H import Control.Applicative -import qualified Data.ByteString.Lazy.Char8 as B +import qualified Data.ByteString.Lazy as B +import qualified Data.ByteString.Lazy.Char8 as C import Data.Char import Data.List +import System.Exit import Test.Tasty import Test.Tasty.HUnit +arbitraryBinary :: B.ByteString +arbitraryBinary = B.pack [1..255] + +createTempFile :: Handsy String +createTempFile = dropWhileEnd isSpace . C.unpack . fst <$> command_ "mktemp" [] "" + test1 = testCase "writeFile . readFile == id" $ do - (h1, h2) <- H.run options{debug=True} $ do - bin <- H.readFile "/bin/sh" - tmp <- dropWhileEnd isSpace . B.unpack . fst <$> command_ "mktemp" [] "" + ret <- H.run options{debug=True} $ do + tmp <- createTempFile - H.writeFile tmp bin + H.writeFile tmp arbitraryBinary + H.readFile tmp - h1 <- takeWhile isHexDigit . B.unpack . fst <$> H.command_ "md5sum" ["/bin/sh"] "" - h2 <- takeWhile isHexDigit . B.unpack . fst <$> H.command_ "md5sum" [tmp] "" + assertEqual "" arbitraryBinary ret - return (h1, h2) +test2 = testCase "appendFile" $ do + ret <- H.run options{debug=True} $ do + tmp <- createTempFile - assertEqual "" h1 h2 + H.writeFile tmp "ut" + H.appendFile tmp "demir" -test2 = testCase "shell" $ do + H.readFile tmp + + assertEqual "" "utdemir" ret + +test3 = testCase "shell" $ do (h1, h2) <- H.run options{debug=True} $ do - h1 <- takeWhile isHexDigit . B.unpack . fst <$> command_ "md5sum" ["/bin/sh"] "" - h2 <- takeWhile isHexDigit . B.unpack . fst <$> shell_ "cat /bin/sh | md5sum -" "" + tmp <- createTempFile + + H.writeFile tmp (B.pack [1..255]) + + h1 <- takeWhile isHexDigit . C.unpack . fst <$> command_ "md5sum" [tmp] "" + h2 <- takeWhile isHexDigit . C.unpack . fst <$> shell_ ("cat " ++ tmp ++ " | md5sum -") "" return (h1, h2) assertEqual "" h1 h2 +test4 = testCase "exit" $ do + (e1, e2) <- H.run options{debug=True} $ do + (e1, _, _) <- command "grep" [] "" + (e2, _, _) <- command "id" [] "" + return (e1, e2) + + case (e1, e2) of + (ExitFailure _, ExitSuccess) -> return () + _ -> assertFailure $ "Invalid return values: " ++ show (e1, e2) + main :: IO () -main = defaultMain (testGroup "handsy" [test1, test2]) +main = defaultMain (testGroup "handsy" [test1, test2, test3, test4])