test-sandbox-compose (empty) → 0.1.0
raw patch · 12 files changed
+822/−0 lines, 12 filesdep +aesondep +basedep +bytestringsetup-changed
Dependencies added: aeson, base, bytestring, cabal-test-bin, containers, directory, hastache, hspec, http-conduit, lifted-base, network, optparse-applicative, process, shakespeare, shelly, test-sandbox, test-sandbox-compose, text, unix, wai, wai-extra, warp, yaml, yesod, yesod-core
Files
- ChangeLog.md +8/−0
- LICENSE +30/−0
- Main.hs +92/−0
- README.md +112/−0
- Setup.hs +2/−0
- Test/Sandbox/Compose.hs +14/−0
- Test/Sandbox/Compose/Core.hs +110/−0
- Test/Sandbox/Compose/Server.hs +188/−0
- Test/Sandbox/Compose/Template.hs +27/−0
- Test/Sandbox/Compose/Type.hs +71/−0
- test-sandbox-compose.cabal +108/−0
- tests/test.hs +60/−0
+ ChangeLog.md view
@@ -0,0 +1,8 @@+## 0.1.0++* Change "return value" of both getPort and setPort from PortNumber-type to Port(Int)-type +* Add Capture*WithFile to data Capture++## 0.0.1.13++* Fix bug that throw error even if exit code is ExitSuccess
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015, Junji Hashimoto++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Junji Hashimoto nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Main.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ExtendedDefaultRules #-}+{-# OPTIONS_GHC -fno-warn-type-defaults #-}++import Test.Sandbox.Compose+import Options.Applicative++import qualified Data.ByteString.Lazy as L+import qualified Data.Text as T+import Shelly hiding (command,run,FilePath)+import Network.HTTP.Conduit+import Control.Monad+import Control.Concurrent++default (T.Text)++type Port=Int++data Command+ = Up [String]+ | Status [String]+ | Conf+ | Kill [String]+ | Logs [String]+ | Destroy+ | Daemon FilePath+ deriving Show++up :: Parser Command+up = Up <$> many (argument str (metavar "TARGET..."))++status :: Parser Command+status = Status <$> many (argument str (metavar "TARGET..."))++conf :: Parser Command+conf = pure Conf++kill :: Parser Command+kill = Kill <$> many (argument str (metavar "TARGET..."))++logs :: Parser Command+logs = Logs <$> many (argument str (metavar "TARGET..."))++destroy :: Parser Command+destroy = pure Destroy++daemon :: Parser Command+daemon = Daemon <$> strOption (long "conf" <> value "test-sandbox-compose.yml" <> metavar "CONFFILE(Yaml)")++parse :: Parser Command+parse = subparser $ foldr1 (<>) [+ command "up" (info up (progDesc "up registered service"))+ , command "status" (info status (progDesc "show sandbox-state"))+ , command "conf" (info conf (progDesc "show internal-conf-file"))+ , command "kill" (info kill (progDesc "kill service"))+ , command "logs" (info logs (progDesc "show logs"))+ , command "destroy" (info destroy (progDesc "destroy deamon"))+ , command "daemon" (info daemon (progDesc "start daemon"))+ ]++setup :: IO Port+setup = shelly $ do+ unlessM (test_e ".sandbox/port") $+ liftIO $ do+ runServer "test-sandbox-compose.yml" False+ threadDelay $ 1*1000*1000+ content <- readfile ".sandbox/port"+ return $ read $ T.unpack content+++runCmd' :: [String] -> String -> IO ()+runCmd' xs cmd' = do+ port' <- setup+ case xs of+ [] -> simpleHttp ("http://localhost:" <> show port' <> "/" <> cmd') >>= L.putStr+ xs' -> forM_ xs' $ \x ->+ simpleHttp ("http://localhost:" <> show port' <> "/" <> cmd' <> "/" <> x) >>= L.putStr++runCmd :: Command -> IO ()+runCmd (Up targets) = runCmd' targets "up"+runCmd (Status targets) = runCmd' targets "status"+runCmd (Kill targets) = runCmd' targets "kill"+runCmd (Logs targets) = runCmd' targets "logs"+runCmd Conf = runCmd' [] "conf"+runCmd Destroy = runCmd' [] "destroy"+runCmd (Daemon conf) = runServer conf True+ +opts :: ParserInfo Command+opts = info (parse <**> helper) idm++main :: IO ()+main = execParser opts >>= runCmd
+ README.md view
@@ -0,0 +1,112 @@+# Test-Sandbox-Compose: Fast Development Environments Using Test-Sandbox++[](https://hackage.haskell.org/package/test-sandbox-compose) [](https://travis-ci.org/junjihashimoto/test-sandbox-compose)++Test-Sandbox-Compose makes development environments for multi-servers using Test-Sandbox.+Each server is defined in test-sandbox-compose.yml.+test-sandbox-compose.yml provides following functions.++* Mustache template for accessing each resource+* Before/After-bash-script for server-setup+* Tempolary file, directory and TCP-Port which test-sandbox provides++This project is inspired by Docker Compose(Fig).++## Getting started++Install this from Hackage.++ cabal update && cabal install test-sandbox-compose+++## test-sandbox-compose.yml reference++```+<service-name1>:+ cmd: <command-name>+ args:+ - <arg1>+ - <arg2>+ confs:+ <conf1>: <conf1 contents>+ <conf2>: <conf2 contents>+ tempfiles:+ - <temp1>+ - <temp2>+ dirs:+ - <dir1>+ - <dir2>+ ports:+ - <port1>+ - <port2>+ beforescript: <script content>+ afterscript: <script content>+<service-name2>+ ...+```++Example++```+zookeeper:+ cmd: '/usr/share/zookeeper/bin/zkServer.sh'+ args:+ - 'start-foreground'+ - '{{zookeeper_conf_conf}}'+ tempfiles: []+ confs:+ conf: |+ dataDir={{zookeeper_dir_data}}+ clientPort={{zookeeper_port_2181}}+ maxClientCnxns=1000+ dirs:+ - 'data'+ ports:+ - '2181'+```+++## Commands+++### Up++```+test-sandbox-compose up+```++### Status++```+test-sandbox-compose status+```++### Conf++```+test-sandbox-compose conf+```++### Kill++```+test-sandbox-compose kill+```++### Logs++```+test-sandbox-compose logs+```++### Destroy++```+test-sandbox-compose destroy+```++### Daemon++```+test-sandbox-compose daemon+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Test/Sandbox/Compose.hs view
@@ -0,0 +1,14 @@+module Test.Sandbox.Compose (+ module Test.Sandbox.Compose.Type+, setupServices+, runServices+, runService+, killServices+, killService+, runServer+ )+where++import Test.Sandbox.Compose.Type+import Test.Sandbox.Compose.Core+import Test.Sandbox.Compose.Server
+ Test/Sandbox/Compose/Core.hs view
@@ -0,0 +1,110 @@+module Test.Sandbox.Compose.Core (+ setupServices+, runServices+, runService+, killServices+, killService+) where++import Control.Monad+import Data.Maybe+import qualified Data.Map as M+import qualified Data.ByteString.Char8 as B+import Test.Sandbox.Compose.Type+import Test.Sandbox.Compose.Template+import Test.Sandbox +import Test.Sandbox.Internals+import qualified Data.Yaml as Y+import System.Process+import System.Exit++getList :: (Service -> [a]) -> Services -> [(ServiceName,a)]+getList func services =+ concat+ $ map (\(k,v) -> map ((,) k) $ func v)+ $ M.toList services++getPortList :: Services -> [(ServiceName, PortName)]+getPortList = getList $ fromMaybe [] . sPorts+getTempList :: Services -> [(ServiceName, TempFileName)]+getTempList = getList $ fromMaybe [] . sTempFiles+getDirList :: Services -> [(ServiceName, DirName)]+getDirList = getList $ fromMaybe [] . sDirs+getConfList :: Services -> [(ServiceName, (ConfName, ConfContent))]+getConfList = getList $ (M.toList . fromMaybe M.empty . sConfs)++setupServices :: Services -> Sandbox (Maybe Services)+setupServices services = do+ ports <- forM (map (\(s,p) -> (s++"_port_"++p)) $ getPortList services) $ \portname -> do+ portnum <- getPort portname+ return (portname,show portnum) :: Sandbox (String,String)+ temps <- forM (map (\(s,p) -> s++"_temp_"++p) $ getTempList services) $ \tempname -> do+ filename <- setFile tempname []+ return (tempname,show filename) :: Sandbox (String,String)+ dirs <- forM (map (\(s,p) -> s++"_dir_"++p) $ getDirList services) $ \dirname -> do+ dir <- getDataDir+ return (dirname,dir++"/"++dirname) :: Sandbox (String,String)+ let params = ports ++ temps ++ dirs+ mPreServices <- updateServices params (Just services)++ case mPreServices of+ Nothing -> return Nothing+ Just preServices -> do + confs <- forM (getConfList preServices) $ \(s,(cn,_)) -> do+ let tempname = s++"_conf_"++cn+ filename <- setFile tempname ""+ return (tempname,filename) :: Sandbox (String,String)+ mServices <- updateServices confs mPreServices+ case mServices of+ Nothing -> return Nothing+ Just services' -> do+ forM_ (getConfList services') $ \(s,(cn,cc)) -> do+ let tempname = s++"_conf_"++cn+ filename <- getFile tempname+ liftIO $ writeFile filename cc+ forM_ (M.toList services') $ \(sname,sconf) -> do+ registerService sname sconf+ return mServices+ where+ updateServices _ Nothing = return Nothing+ updateServices params (Just service) = do+ service' <- liftIO $ applyTemplate params $ B.unpack $ Y.encode service+ return $ Y.decode $ B.pack service'++runServices :: Services -> Sandbox ()+runServices services = do+ forM_ (M.toList services) $ \(k,_) -> do+ runService k services++registerService :: ServiceName -> Service -> Sandbox ()+registerService serviceName service = do+ dir <- getDataDir+ let k = serviceName+ let v = service+ void $ register k (sCmd v) (sArgs v) (def{psWait = Just 3,psCapture=Just (CaptureBothWithFile (dir ++ "/" ++ k ++ "_out.txt") (dir ++ "/" ++ k ++ "_err.txt"))})++runService :: ServiceName -> Services -> Sandbox ()+runService serviceName services = do+ let k = serviceName+ let v = services M.! serviceName+ case sBeforeScript v of+ Just script -> do+ r@(c,_,_) <- liftIO $ readProcessWithExitCode "bash" ["-c",script] []+ when (c /= ExitSuccess) $ do+ error $ "BeforeScript Error:\n" ++ show r+ Nothing -> return ()+ void $ start k+ case sAfterScript v of+ Just script -> do+ r@(c,_,_) <- liftIO $ readProcessWithExitCode "bash" ["-c",script] []+ when (c /= ExitSuccess) $ do+ error $ "AfterScript Error:\n" ++ show r+ Nothing -> return ()++killService :: ServiceName -> Sandbox ()+killService k = stop k++killServices :: Sandbox ()+killServices = do+ stopAll+ cleanUpProcesses
+ Test/Sandbox/Compose/Server.hs view
@@ -0,0 +1,188 @@+{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell, MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ViewPatterns #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -fno-warn-type-defaults #-}++module Test.Sandbox.Compose.Server where++import Test.Sandbox.Compose.Type+import Test.Sandbox.Compose.Core++import Network.Wai.Handler.Warp (run)+import Yesod.Core+import qualified Data.Text as T+import Data.IORef.Lifted+import Test.Sandbox hiding (run)+import Test.Sandbox.Internals hiding (Port)+import qualified Data.Yaml as Y+import qualified Data.Map as M+import Control.Concurrent+import System.Exit+import System.Directory+import System.Posix.Process+import System.Posix hiding (Kill)+import Shelly hiding (command,run,FilePath)+import Data.Monoid++default (T.Text)++instance Yesod App where+ errorHandler e = liftIO (appendFile ".sandbox/log" (show e)) >> defaultErrorHandler e++getUpAllR :: HandlerT App IO RepPlain+getUpAllR = do+ (App serv sand) <- getYesod+ result <- liftIO $ flip runSandbox sand $ do+ runServices =<< readIORef serv+ case result of+ Right _ -> return $ RepPlain "OK\n"+ Left err -> return $ RepPlain $ toContent $ err++getUpR :: ServiceName -> HandlerT App IO RepPlain+getUpR serviceName = do+ (App serv sand) <- getYesod+ result <- liftIO $ flip runSandbox sand $ do+ runService serviceName =<< readIORef serv+ case result of+ Right _ -> return $ RepPlain "OK\n"+ Left err -> return $ RepPlain $ toContent $ err+++getStatusAllR :: HandlerT App IO RepPlain+getStatusAllR = do+ (App _serv sand) <- getYesod+ sand' <- liftIO $ readIORef sand+ return $ RepPlain $ toContent $ Y.encode $ sand' {ssAvailablePorts=[]}+ +getStatusR :: ServiceName -> HandlerT App IO RepPlain+getStatusR serviceName = do+ (App _serv sand) <- getYesod+ sand' <- liftIO $ readIORef sand+ return $ RepPlain $ toContent $ Y.encode $ M.lookup serviceName $ ssProcesses sand'+ +getConfR :: HandlerT App IO RepPlain+getConfR = do+ (App serv _sand) <- getYesod+ sand' <- liftIO $ readIORef serv+ return $ RepPlain $ toContent $ Y.encode $ sand'+ +getKillAllR :: HandlerT App IO RepPlain+getKillAllR = do+ (App _ sand) <- getYesod+ result <- liftIO $ flip runSandbox sand $ do+ killServices+ case result of+ Right _ -> return $ RepPlain "OK\n"+ Left err -> return $ RepPlain $ toContent $ err++getKillR :: ServiceName -> HandlerT App IO RepPlain+getKillR serviceName = do+ (App _ sand) <- getYesod+ result <- liftIO $ flip runSandbox sand $ do+ killService serviceName+ case result of+ Right _ -> return $ RepPlain "OK\n"+ Left err -> return $ RepPlain $ toContent $ err+++getDestroyR :: HandlerT App IO RepPlain+getDestroyR = do+ (App _ sand) <- getYesod+ _ <- liftIO $ flip runSandbox sand $ do+ killServices+ _ <- liftIO $ forkIO $ do+ threadDelay (1*1000*1000)+ shelly $ do+ rm ".sandbox/port" + exitImmediately ExitSuccess+ return $ RepPlain "OK\n"+++getLogsDaemonR :: HandlerT App IO RepPlain+getLogsDaemonR = do+ out <- liftIO $ readFile (".sandbox/" <> ".server" <> "_out.txt")+ err <- liftIO $ readFile (".sandbox/" <> ".server" <> "_err.txt")+ return $ RepPlain $ toContent $ out <> err+ +getLogsR :: ServiceName -> HandlerT App IO RepPlain+getLogsR serviceName = do+ out <- liftIO $ readFile (".sandbox/" <> serviceName <> "_out.txt")+ err <- liftIO $ readFile (".sandbox/" <> serviceName <> "_err.txt")+ return $ RepPlain $ toContent $ out <> err+ + +mkYesod "App" [parseRoutes|+/up UpAllR GET+/up/#ServiceName UpR GET+/status StatusAllR GET+/status/#ServiceName StatusR GET+/conf ConfR GET+/kill KillAllR GET+/kill/#ServiceName KillR GET+/logs LogsDaemonR GET+/logs/#ServiceName LogsR GET+/destroy DestroyR GET+|]+++runServer' :: FilePath -> IO (App,Int)+runServer' conf = do+ cdir <- getCurrentDirectory+ let dir=(cdir <> "/.sandbox")+ shelly $ do+ unlessM (test_e ".sandbox") $+ mkdir ".sandbox"+ state <- newSandboxState "compose" dir+ port <- runSandbox' state $ do+ getPort "test-sandbox-compose"+ writeFile (dir <> "/port") $ show port+ eServ <- Y.decodeFileEither conf :: IO (Either Y.ParseException Services)+ case eServ of+ Left err -> do+ print err+ exitWith $ ExitFailure 1+ Right serv -> do+ serv' <- runSandbox' state $ do+ mserv <- setupServices serv+ case mserv of+ Just s -> return s+ Nothing -> liftIO $ do+ print "setupServices is failed."+ exitWith $ ExitFailure 1+ services <- newIORef serv'+ return (App services state,port)++runServer :: FilePath -> Bool -> IO ()+runServer conf enbBackGround = do+ (app,port) <- runServer' conf+ let prog :: IO ()+ prog = toWaiApp app >>= run port+ backGround enbBackGround prog++backGround :: Bool -> IO () -> IO ()+backGround exitP prog = do+ _ <- forkProcess p+ when exitP $ do+ exitImmediately ExitSuccess+ where+ p = do+ _ <- createSession+ _ <- forkProcess p'+ exitImmediately ExitSuccess+ p' = do+ switchDescriptors+ prog+ switchDescriptors :: IO ()+ switchDescriptors = do+ null' <- openFd "/dev/null" ReadWrite Nothing defaultFileFlags+ out <- openFd ".sandbox/.server_out.txt" ReadWrite (Just 0o644) defaultFileFlags+ err <- openFd ".sandbox/.server_err.txt" ReadWrite (Just 0o644) defaultFileFlags+ let sendTo' fd' fd = closeFd fd >> dupTo fd' fd+ _ <- sendTo' null' stdInput+ _ <- sendTo' out stdOutput+ _ <- sendTo' err stdError+ return ()+
+ Test/Sandbox/Compose/Template.hs view
@@ -0,0 +1,27 @@++module Test.Sandbox.Compose.Template (+ applyTemplate+) where++import qualified Text.Hastache as H+import qualified Text.Hastache.Context as H+import qualified Data.Text.Lazy as TL+import qualified Data.Text as T+import qualified Data.Map as M++applyTemplate :: H.MuVar a+ => [(String, a)]+ -> String+ -> IO String+applyTemplate keyValues template = do+ str' <- H.hastacheStr+ H.defaultConfig+ (H.encodeStr template)+ (H.mkStrContext context')+ return $ T.unpack $ TL.toStrict str'+ where+ context' :: Monad m => String -> H.MuType m+ context' str' = case M.lookup str' (M.fromList (map (\(k,v) -> (k,H.MuVariable v)) keyValues)) of+ Just val -> val+ Nothing -> H.MuVariable ("{{"++str'++"}}")+
+ Test/Sandbox/Compose/Type.hs view
@@ -0,0 +1,71 @@+{-#LANGUAGE TemplateHaskell#-}+{-#LANGUAGE StandaloneDeriving#-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Test.Sandbox.Compose.Type where++import Control.Applicative+import Control.Monad+import Data.Aeson+import Data.Aeson.TH+import Data.Char+import qualified Data.Map as M+import qualified Data.Text.Encoding as T+import Test.Sandbox.Internals+import Data.ByteString (ByteString)+import Data.IORef+import System.Process hiding (env, waitForProcess)+import System.Posix.Types+import System.Exit+import System.IO++type ServiceName = String+type PortName = String+type TempFileName = String+type DirName = String+type ConfName = String+type ConfContent = String++type Services = M.Map ServiceName Service++data Service = Service {+ sCmd :: FilePath+, sArgs :: [String]+, sConfs :: Maybe (M.Map ConfName ConfContent)+, sDirs :: Maybe [DirName]+, sTempFiles :: Maybe [TempFileName]+, sPorts :: Maybe [PortName]+, sBeforeScript :: Maybe String+, sAfterScript :: Maybe String+} deriving (Show,Read,Eq)++$(deriveJSON defaultOptions{fieldLabelModifier = drop 1.map toLower, constructorTagModifier = map toLower} ''Service)++$(deriveJSON defaultOptions{fieldLabelModifier = drop 2.map toLower, constructorTagModifier = map toLower} ''SandboxState)+$(deriveJSON defaultOptions{fieldLabelModifier = drop 2.map toLower, constructorTagModifier = map toLower} ''SandboxedProcess)+$(deriveJSON defaultOptions ''Capture)+$(deriveJSON defaultOptions ''SandboxedProcessInstance)+$(deriveJSON defaultOptions ''CPid)+$(deriveJSON defaultOptions ''ExitCode)++instance ToJSON ByteString where+ toJSON = toJSON . T.decodeUtf8+instance FromJSON ByteString where+ parseJSON (String str) = pure $ T.encodeUtf8 $ str+ parseJSON _ = mzero++instance ToJSON Handle where+ toJSON = toJSON . show+instance FromJSON Handle where+ parseJSON _ = pure $ stderr++instance ToJSON ProcessHandle where+ toJSON _ = toJSON $ show "ProcessHandle"+instance FromJSON ProcessHandle where+ parseJSON _ = mzero++data App = App {+ appServices :: IORef Services+, appState :: IORef SandboxState+}+
+ test-sandbox-compose.cabal view
@@ -0,0 +1,108 @@+-- Initial test-sandbox-compose.cabal generated by cabal init. For further+-- documentation, see http://haskell.org/cabal/users-guide/++name: test-sandbox-compose+version: 0.1.0+synopsis: Lightweight development enviroments using test-sandbox+description: +license: BSD3+license-file: LICENSE+author: Junji Hashimoto+maintainer: junji.hashimoto@gmail.com+-- copyright: +category: Testing+build-type: Simple+-- extra-source-files: +cabal-version: >=1.10++bug-reports: https://github.com/junjihashimoto/test-sandbox-compose/issues++extra-source-files:+ ChangeLog.md+ README.md++source-repository head+ type: git+ location: https://github.com/junjihashimoto/test-sandbox-compose.git+++library+ exposed-modules: Test.Sandbox.Compose+ , Test.Sandbox.Compose.Type+ , Test.Sandbox.Compose.Core+ , Test.Sandbox.Compose.Template+ , Test.Sandbox.Compose.Server+ -- other-modules: + -- other-extensions: + build-depends: base >= 4 && < 5+ , aeson+ , containers+ , hastache+ , text+ , containers+ , test-sandbox >= 0.1+ , yaml+ , network+ , yesod+ , yesod-core+ , wai+ , wai-extra+ , bytestring+ , warp+ , process+ , lifted-base+ , directory+ , unix+ , shelly+ , http-conduit+ -- hs-source-dirs: + default-language: Haskell2010+ ghc-options: -Wall+++executable test-sandbox-compose+ main-is: Main.hs + -- other-modules: + -- other-extensions: + build-depends: base >= 4 && < 5+ , test-sandbox-compose+ , optparse-applicative+ , aeson+ , containers+ , hastache+ , text+ , containers+ , test-sandbox+ , yaml+ , network+ , yesod+ , yesod-core+ , wai+ , wai-extra+ , bytestring+ , warp+ , process+ , lifted-base+ , directory+ , unix+ , shelly+ , http-conduit+ -- hs-source-dirs: + default-language: Haskell2010+ ghc-options: -Wall++test-suite test+ type: exitcode-stdio-1.0+ main-is: test.hs+ hs-source-dirs: tests+ ghc-options: -Wall++ build-depends: base >= 4 && < 5+ , hspec+ , shakespeare+ , text+ , bytestring+ , process+ , unix+ , cabal-test-bin >= 0.1.4+ Default-Language: Haskell2010
+ tests/test.hs view
@@ -0,0 +1,60 @@+{-#LANGUAGE TemplateHaskell#-}+{-#LANGUAGE QuasiQuotes#-}+{-#LANGUAGE OverloadedStrings#-}++import Test.Hspec+import Text.Shakespeare.Text++import qualified Data.Text as T++import Test.Cabal.Path+import System.Process+import System.Exit++main :: IO ()+main = do+ bin <- getExePath "." "test-sandbox-compose"+ hspec $ do+ describe "Server Test" $ do+ it "help" $ do+ (c,o,e) <- readProcessWithExitCode bin ["--help"] []+ c `shouldBe` ExitSuccess+ e `shouldBe` ""+ o `shouldBe` T.unpack [sbt|Usage: test-sandbox-compose COMMAND+ |+ |Available options:+ | -h,--help Show this help text+ |+ |Available commands:+ | up up registered service+ | status show sandbox-state+ | conf show internal-conf-file+ | kill kill service+ | logs show logs+ | destroy destroy deamon+ | daemon start daemon+ |]+ it "up" $ do+ (c,o,e) <- readProcessWithExitCode bin ["up"] []+ e `shouldBe` ""+ o `shouldBe` T.unpack [sbt|OK+ |]+ c `shouldBe` ExitSuccess+ it "kill" $ do+ (c,o,e) <- readProcessWithExitCode bin ["kill"] []+ e `shouldBe` ""+ o `shouldBe` T.unpack [sbt|OK+ |]+ c `shouldBe` ExitSuccess+ it "up" $ do+ (c,o,e) <- readProcessWithExitCode bin ["up"] []+ e `shouldBe` ""+ o `shouldBe` T.unpack [sbt|OK+ |]+ c `shouldBe` ExitSuccess+ it "destroy" $ do+ (c,o,e) <- readProcessWithExitCode bin ["destroy"] []+ e `shouldBe` ""+ o `shouldBe` T.unpack [sbt|OK+ |]+ c `shouldBe` ExitSuccess