diff --git a/handsy.cabal b/handsy.cabal --- a/handsy.cabal +++ b/handsy.cabal @@ -1,5 +1,5 @@ name: handsy -version: 0.0.7 +version: 0.0.8 synopsis: A DSL to describe common shell operations and interpeters for running them locally and remotely. -- description: Homepage: https://github.com/utdemir/handsy @@ -18,7 +18,7 @@ library exposed-modules: System.Handsy System.Handsy.Remote - System.Handsy.Internal + System.Handsy.Core build-depends: base >=4.6 && <4.8 , bytestring , process @@ -29,3 +29,18 @@ hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall + +test-suite tests + type: exitcode-stdio-1.0 + main-is: Test.hs + default-language: Haskell2010 + hs-source-dirs: src test + build-depends: base >=4.6 && < 4.8 + , bytestring + , process + , transformers + , free + , process-extras + , shell-escape + , tasty + , tasty-hunit diff --git a/src/System/Handsy.hs b/src/System/Handsy.hs --- a/src/System/Handsy.hs +++ b/src/System/Handsy.hs @@ -1,7 +1,13 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -module System.Handsy where +module System.Handsy + ( module System.Handsy + , Handsy + , Options + , options + , debug + ) where import qualified Data.ByteString.Lazy as B import qualified Data.ByteString.Lazy.Char8 as C @@ -10,10 +16,8 @@ import Control.Monad.Trans.Free import System.Process.ByteString.Lazy -import System.Handsy.Internal (HandsyF (..)) -import qualified System.Handsy.Internal as T - -type Handsy = FreeT T.HandsyF IO +import System.Handsy.Core hiding (command) +import qualified System.Handsy.Core as I -- * Actions @@ -22,19 +26,25 @@ -> [String] -- ^ Arguments -> B.ByteString -- ^ Standart Input -> Handsy (ExitCode, B.ByteString, B.ByteString) -- ^ (status, stdout, stderr) -command = T.command +command = I.command -- | Reads a file and returns the contents of the file. readFile :: FilePath -> Handsy B.ByteString -readFile = T.readFile +readFile fp = command "cat" [fp] "" >>= \case + (ExitSuccess, stdin, _) -> return stdin + _ -> error $ "Error reading " ++ fp --- | 'writeFile' @file str@ function writes the bytestring @str@, to the file @file@. +-- | @writeFile file str@ function writes the bytestring @str@, to the file @file@. writeFile :: FilePath -> B.ByteString -> Handsy () -writeFile = T.writeFile +writeFile fp s = command "dd" ["of=" ++ fp] s >>= \case + (ExitSuccess, stdin, _) -> return () + _ -> error $ "Error writing to " ++ fp --- | 'appendFile' @file str@ function appends the bytestring @str@, to the file @file@. +-- | @appendFile file str@ function appends the bytestring @str@, to the file @file@. appendFile :: FilePath -> B.ByteString -> Handsy () -appendFile = T.appendFile +appendFile fp s = command "dd" ["of=" ++ fp, "conv=notrunc", "oflag=append"] s >>= \case + (ExitSuccess, stdin, _) -> return () + _ -> error $ "Error appending to " ++ fp -- * Helpers @@ -63,18 +73,5 @@ -- * Interpreter --- | Executes the actions locally -run :: Handsy a -> IO a -run h = do - x <- runFreeT h - case x of - Pure r -> return r - Free (ReadFile fp next) - -> B.readFile fp >>= run . next - Free (WriteFile fp str next) - -> B.writeFile fp str >>= run . next - Free (AppendFile fp str next) - -> B.appendFile fp str >>= run . next - Free (Command prg args stdin next) - -> readProcessWithExitCode prg args stdin >>= run . next - +run :: Options -> Handsy a -> IO a +run = interpretSimple readProcessWithExitCode diff --git a/src/System/Handsy/Core.hs b/src/System/Handsy/Core.hs new file mode 100644 --- /dev/null +++ b/src/System/Handsy/Core.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TemplateHaskell #-} + +module System.Handsy.Core + ( Handsy + , interpret + , interpretSimple + , command + , Options + , options + , debug + ) where + +import Control.Exception (bracket) +import Control.Monad +import Control.Monad.Free.TH +import Control.Monad.Trans.Free +import qualified Data.ByteString.Lazy as B +import System.Exit +import System.IO + +data HandsyF k = + Command FilePath [String] B.ByteString ((ExitCode, B.ByteString, B.ByteString) -> k) + deriving (Functor) + +makeFree ''HandsyF + +type Handsy = FreeT HandsyF IO + +data Options = + Options { debug :: Bool -- ^ Log commands to stderr before running + } + +options :: Options +options = Options True + +interpret :: IO r -- ^ Acquire resource + -> (r -> IO ()) -- ^ Release resource + -> (r -> String -> [String] -> B.ByteString + -> IO (ExitCode, B.ByteString, B.ByteString)) -- ^ 'readProcessWithExitCode' + resource + -> Options + -> Handsy a + -> IO a +interpret acquire destroy f opts handsy = bracket acquire destroy (flip 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 + +interpretSimple :: (String -> [String] -> B.ByteString + -> IO (ExitCode, B.ByteString, B.ByteString)) -- ^ 'readProcessWithExitCode' + -> Options + -> Handsy a + -> IO a +interpretSimple f = interpret (return ()) (const (return ())) (const f) diff --git a/src/System/Handsy/Internal.hs b/src/System/Handsy/Internal.hs deleted file mode 100644 --- a/src/System/Handsy/Internal.hs +++ /dev/null @@ -1,19 +0,0 @@ -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE TemplateHaskell #-} - -module System.Handsy.Internal where - -import Control.Monad.Free -import Control.Monad.Free.TH -import qualified Data.ByteString.Lazy as B -import System.Exit - -data HandsyF k = - Command FilePath [String] B.ByteString ((ExitCode, B.ByteString, B.ByteString) -> k) - | ReadFile FilePath (B.ByteString -> k) - | WriteFile FilePath B.ByteString (() -> k) - | AppendFile FilePath B.ByteString (() -> k) - deriving (Functor) - -makeFree ''HandsyF 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,9 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} module System.Handsy.Remote where -import System.Handsy as H -import System.Handsy.Internal (HandsyF (..)) +import Prelude hiding (appendFile, readFile, + writeFile) +import System.Handsy +import System.Handsy.Core (interpretSimple) + import qualified Data.ByteString.Char8 as C8 import qualified Data.ByteString.Lazy as B import System.Exit @@ -19,34 +22,22 @@ } -- | Executes the actions at a remote host -runRemote :: RemoteOptions -> Handsy a -> IO a -runRemote opts h = do - x <- runFreeT h - case x of - Pure r -> return r - Free (ReadFile fp next) - -> runSsh "cat" [fp] "" >>= \(_, stdin, _) -> runRemote opts (next stdin) - Free (WriteFile fp str next) - -> runSsh "dd" ["of=" ++ fp] str >> runRemote opts (next ()) - Free (AppendFile fp str next) - -> runSsh "dd" ["of=" ++ fp, "conv=notrunc", "oflag=append"] str >> runRemote opts (next ()) - Free (Command prg args stdin next) - -> runSsh prg args stdin >>= runRemote opts . next - +runRemote :: Options -> RemoteOptions -> Handsy a -> IO a +runRemote opts remote = interpretSimple runSsh opts where runSsh :: String -> [String] -> B.ByteString -> IO (ExitCode, B.ByteString, B.ByteString) runSsh prg args stdin = let c = C8.unpack . C8.intercalate " " . map (bytes . bash . C8.pack) $ (prg:args) - (ssh, sshOpts) = sshCommand opts - in run $ command ssh (sshOpts ++ [c]) stdin + (ssh, sshOpts) = sshCommand remote + in run options $ command ssh (sshOpts ++ [c]) stdin -- | Copies a local file to remote host pushFile :: FilePath -- ^ Local path of source -> FilePath -- ^ Remote path of destination -> Handsy () -pushFile local remote = liftIO (B.readFile local) >>= H.writeFile remote +pushFile local remote = liftIO (B.readFile local) >>= writeFile remote -- | Fetches a file from remote host pullFile :: FilePath -- ^ Remote path of source -> FilePath -- ^ Local path of destination -> Handsy () -pullFile remote local = H.readFile remote >>= liftIO . B.writeFile local +pullFile remote local = readFile remote >>= liftIO . B.writeFile local diff --git a/test/Test.hs b/test/Test.hs new file mode 100644 --- /dev/null +++ b/test/Test.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Main where + +import System.Handsy as H + +import Control.Applicative +import qualified Data.ByteString.Lazy.Char8 as B +import Data.Char +import Data.List + +import Test.Tasty +import Test.Tasty.HUnit + +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" [] "" + + H.writeFile tmp bin + + h1 <- takeWhile isHexDigit . B.unpack . fst <$> H.command_ "md5sum" ["/bin/sh"] "" + h2 <- takeWhile isHexDigit . B.unpack . fst <$> H.command_ "md5sum" [tmp] "" + + return (h1, h2) + + assertEqual "" h1 h2 + +test2 = 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 -" "" + return (h1, h2) + + assertEqual "" h1 h2 + +main :: IO () +main = defaultMain (testGroup "handsy" [test1, test2])