diff --git a/Test/Hspec/Server/Command.hs b/Test/Hspec/Server/Command.hs --- a/Test/Hspec/Server/Command.hs +++ b/Test/Hspec/Server/Command.hs @@ -1,4 +1,10 @@ -module Test.Hspec.Server.Command where +module Test.Hspec.Server.Command ( + package +, process +, service +, port +, command + )where import System.Exit import Control.Monad @@ -8,15 +14,50 @@ import Test.Hspec.Server.Type import Test.Hspec.Server.Core +cmd :: ServerType dat => dat -> FilePath -> [String] -> String -> IO (ExitCode,String,String) +cmd = stCmd + +type Patterns = [String] +type Arg = [String] +type Input = String +type TestType = String +type TestedName = String + +cmdAndChk :: (ServerType dat, Sets s) + => TestType + -> s + -> s + -> FilePath + -> Arg + -> Input + -> Patterns + -> ServerExample dat (Either String s) +cmdAndChk test testedval failedval c arg i [] = do + dat <- getServerData + c@(code,out,_) <- liftIO $ cmd dat c arg i + if (code /= ExitSuccess) + then return $ Left $ test <> " error:" ++ show c + else return $ Right testedval +cmdAndChk test testedval failedval c arg i patterns = do + dat <- getServerData + c@(code,out,_) <- liftIO $ cmd dat c arg i + if (code /= ExitSuccess) + then do + return $ Left $ test <> " error:" ++ show c + else do + if or (map (\v -> foldr (||) False + (map (\p -> v =~ p) patterns) + ) + (lines out)) + then return $ Right testedval + else return $ Right failedval + package :: ServerType dat => String -> ServerExample dat ServerStatus package pkg = do - dat <- getServerData - c@(code,out,_) <- liftIO $ cmd dat "dpkg" ["-l",pkg] [] - when (code /= ExitSuccess) $ do - error $ "pacakge error:" ++ show c - if or (map (\v -> v =~ ("^ii +" <> pkg <> " ")) (lines out)) - then return Installed - else return None + r <- cmdAndChk "package" Installed None "dpkg" ["-l",pkg] [] ["^ii +"<>pkg<>" "] + case r of + Left err -> error err + Right v -> return v process :: ServerType dat => String -> ServerExample dat ServerStatus process ps = do @@ -29,28 +70,32 @@ service :: ServerType dat => String -> ServerExample dat ServerStatus service s = do dat <- getServerData - c@(code,out,_) <- liftIO $ cmd dat ("/etc/init.d/"++s) ["status"] [] - when (code /= ExitSuccess) $ do - error $ "service error:" ++ show c - if or (map (\v -> - (v =~ ("is running" :: String)) || - (v =~ ("start/running" :: String)) - ) (lines out)) - then return Running - else return None + (_code,_out,_) <- liftIO $ cmd dat ("/etc/init.d/"++s) ["status"] [] + if _code == ExitSuccess + then check _out + else do + c@(code,out,_) <- liftIO $ cmd dat "sudo" ["service",s,"status"] [] + when (code /= ExitSuccess) $ do + error $ "service error:" ++ show c + check out + where + check out = + if or (map (\v -> + (v =~ ("is running" :: String)) || + (v =~ ("start/running" :: String)) + ) (lines out)) + then return Running + else return None port :: ServerType dat => Int -> ServerExample dat ServerStatus port p = do - dat <- getServerData - c@(code,out,_) <- liftIO $ cmd dat "netstat" ["-tanp"] [] - when (code /= ExitSuccess) $ do - error $ "port error:" ++ show c - if or (map (\v -> - (v =~ ("^tcp[ 6] +[0-9]+ +[0-9]+ :::" <> show p <> " +[^ ]+ +LISTEN")) || - (v =~ ("^tcp[ 6] +[0-9]+ +[0-9]+ [0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+:" <> show p <> " +[^ ]+ +LISTEN")) - ) (lines out)) - then return Listening - else return None + r <- cmdAndChk "port" Listening None + "netstat" ["-tanp"] [] + ["^tcp[ 6] +[0-9]+ +[0-9]+ :::" <> (show p) <> " +[^ ]+ +LISTEN", + "^tcp[ 6] +[0-9]+ +[0-9]+ [0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+:" <> (show p) <> " +[^ ]+ +LISTEN"] + case r of + Left err -> error err + Right v -> return v command :: ServerType dat => FilePath -> [String] -> String -> ServerExample dat CommandStatus command c arg inp = do diff --git a/Test/Hspec/Server/Core.hs b/Test/Hspec/Server/Core.hs --- a/Test/Hspec/Server/Core.hs +++ b/Test/Hspec/Server/Core.hs @@ -1,54 +1,19 @@ module Test.Hspec.Server.Core where -import qualified Test.Hspec.Core.Spec as Hspec +import qualified Test.Hspec as Hspec import qualified Test.HUnit as HUnit -import Control.Monad.Trans.Writer import Control.Monad.IO.Class -import qualified Control.Monad.Trans.State as ST +import Control.Monad.Trans.Reader import Test.Hspec.Server.Type -serverSpecOS :: ServerType dat - => dat - -> ServerOS - -> ServerSpec dat - -> Hspec.Spec -serverSpecOS serverData' serverOS' sspecs = do - dat' <- Hspec.runIO $ setup serverData' - os' <- case serverOS' of - AutoDetect -> do - v <- Hspec.runIO $ detectOS dat' - case v of - Just v' -> return v' - Nothing -> error "can not detect os" - _ -> return serverOS' - Hspec.fromSpecList $ map (unServer (dat',os')) $ execWriter sspecs - where - unServer (dat',os') (ServerSpecGroup x y) = Hspec.specGroup x $ map (unServer (dat',os')) y - unServer (dat',os') (ServerSpecItem x y) = Hspec.specItem x $ - ST.evalStateT y ServerExampleData { - serverData = dat' - , serverOS = os' - } - -serverSpec :: ServerType dat - => dat - -> ServerSpec dat - -> Hspec.Spec -serverSpec serverData' sspecs = do - serverSpecOS serverData' AutoDetect sspecs - getServerData :: ServerType dat => ServerExample dat dat -getServerData = fmap serverData ST.get - -getServerOS :: ServerExample dat ServerOS -getServerOS = fmap serverOS ST.get - -it :: ServerType dat => String -> ServerExample dat () -> ServerSpec dat -it label example = tell [ServerSpecItem label example] +getServerData = ask -describe :: ServerType dat => String -> ServerSpec dat -> ServerSpec dat -describe label sspecs = tell [ServerSpecGroup label $ execWriter sspecs] +getServerOS :: ServerType dat => ServerExample dat (Maybe ServerOS) +getServerOS = do + d <- ask + return $ stOS d includes' :: (ServerType dat, Sets s) => s -> s -> ServerExample dat () includes' org ex = @@ -62,3 +27,12 @@ org <- org' org `includes'` ex +(@>=) :: (ServerType dat, Sets s) => ServerExample dat s -> s -> ServerExample dat () +(@>=) = includes +infix 1 @>= + +(@==) :: (ServerType dat, Sets s) => ServerExample dat s -> s -> ServerExample dat () +(@==) org' ex = do + org <- org' + liftIO $ Hspec.shouldBe org ex +infix 1 @== diff --git a/Test/Hspec/Server/ServerType.hs b/Test/Hspec/Server/ServerType.hs --- a/Test/Hspec/Server/ServerType.hs +++ b/Test/Hspec/Server/ServerType.hs @@ -9,15 +9,20 @@ import Control.Monad import Test.Hspec.Server.Type -data Localhost = Localhost deriving (Show,Eq) +data Localhost = Localhost { + lOS :: !(Maybe ServerOS) + }deriving (Show,Eq) localhost :: Localhost -localhost = Localhost +localhost = Localhost Nothing instance ServerType Localhost where - setup a = return a - name _ = "localhost" - cmd _ = readProcessWithExitCode + stSetup a = do + os' <- detectOS a + return $ a {lOS = os'} + stOS = lOS + stName _ = "localhost" + stCmd _ = readProcessWithExitCode data Ssh = Ssh { sshHostName :: String @@ -25,15 +30,19 @@ , sshConf :: Maybe String , sshPort :: Maybe Int , sshUser :: Maybe String +, sshOS :: !(Maybe ServerOS) } deriving (Show,Eq) ssh :: String -> Ssh -ssh hostname = Ssh hostname Nothing Nothing Nothing Nothing +ssh hostname = Ssh hostname Nothing Nothing Nothing Nothing Nothing instance ServerType Ssh where - setup a = return a - name = sshHostName - cmd d c arg i = do + stSetup a = do + os' <- detectOS a + return $ a {sshOS = os'} + stOS = sshOS + stName = sshHostName + stCmd d c arg i = do readProcessWithExitCode "ssh" (sshOpt ++ [sshHost] ++ [c] ++ arg) i where sshOpt = @@ -45,20 +54,23 @@ data Vagrant = Vagrant { vHostName :: String , vConf :: Maybe String + , vOS :: !(Maybe ServerOS) } deriving (Show,Eq) vagrant :: String -> Vagrant -vagrant hostname = Vagrant hostname Nothing +vagrant hostname = Vagrant hostname Nothing Nothing instance ServerType Vagrant where - setup a = do + stSetup a = do + os' <- detectOS a (e,conf,_) <- readProcessWithExitCode "vagrant" ["ssh-config"] [] when (e /= ExitSuccess) $ do error "vagrant setup error" - return $ a {vConf = Just conf} - name = vHostName - cmd d c arg i = withSystemTempFile "hspec-server" $ \file handle -> do + return $ a {vConf = Just conf,vOS = os'} + stOS = vOS + stName = vHostName + stCmd d c arg i = withSystemTempFile "hspec-server" $ \file handle -> do hPutStr handle (fromJust (vConf d)) hClose handle - readProcessWithExitCode "ssh" (["-F",file,name d,c]++arg) i + readProcessWithExitCode "ssh" (["-F",file,stName d,c]++arg) i diff --git a/Test/Hspec/Server/Type.hs b/Test/Hspec/Server/Type.hs --- a/Test/Hspec/Server/Type.hs +++ b/Test/Hspec/Server/Type.hs @@ -2,9 +2,10 @@ module Test.Hspec.Server.Type where import System.Exit -import qualified Control.Monad.Trans.State as ST +import Control.Monad.Trans.Reader import Control.Monad.Trans.Writer import qualified Test.Hspec.Core.Spec as Hspec +import Test.Hspec (before) import Control.Monad import Data.Monoid @@ -29,38 +30,25 @@ type ServerName = String class ServerType a where - setup :: a -> IO a - name :: a -> ServerName - cmd :: a -> FilePath -> [String] -> String -> IO (ExitCode,String,String) + stSetup :: a -> IO a + stOS :: a -> Maybe ServerOS + stName :: a -> ServerName + stCmd :: a -> FilePath -> [String] -> String -> IO (ExitCode,String,String) -data ServerExampleData dat = ServerExampleData { - serverData :: !dat - , serverOS :: !ServerOS - } +type ServerExample dat = ReaderT dat IO -type ServerExample dat = ST.StateT (ServerExampleData dat) IO +with :: ServerType dat => dat -> Hspec.SpecWith dat -> Hspec.Spec +with d = before (stSetup d) -instance (ServerType dat) => Hspec.Example (ServerExample dat a) where - type Arg (ServerExample dat a) = dat +instance (ServerType dat) => Hspec.Example (ServerExample dat ()) where + type Arg (ServerExample dat ()) = dat evaluateExample example params action = Hspec.evaluateExample - (action $ \dat' -> do - os <- detectOS dat' - _ <- ST.evalStateT example ServerExampleData { - serverData = dat' - , serverOS = fromJust os - } - return ()) + (action $ runReaderT example) params ($ ()) -type ServerSpec dat = Writer [ServerSpecTree dat] () - -data ServerSpecTree dat - = ServerSpecGroup String [ServerSpecTree dat] - | ServerSpecItem String (ServerExample dat ()) - -class Show a => Sets a where +class (Eq a ,Show a) => Sets a where include :: a -> a -> Bool data ServerStatus = @@ -112,18 +100,18 @@ getStdout :: CommandStatus -> Maybe String getStdout (Stdout code) = Just code -getStdout (CAnd statuss) = listToMaybe $ catMaybes $ map getStdout $ S.toList statuss +getStdout (CAnd statuss) = listToMaybe $ mapMaybe getStdout $ S.toList statuss getStdout _ = Nothing getStderr :: CommandStatus -> Maybe String getStderr (Stderr code) = Just code -getStderr (CAnd statuss) = listToMaybe $ catMaybes $ map getStdout $ S.toList statuss +getStderr (CAnd statuss) = listToMaybe $ mapMaybe getStdout $ S.toList statuss getStderr _ = Nothing detectOS :: ServerType dat => dat -> IO (Maybe ServerOS) detectOS dat = do - v@(code,out,_) <- cmd dat "sh" ["-c","echo $OSTYPE"] [] + v@(code,out,_) <- stCmd dat "bash" ["-c","echo $OSTYPE"] [] when (code /= ExitSuccess) $ do error $ "detectOS's error;" ++ show v case listToMaybe (lines out) of @@ -143,7 +131,8 @@ detectLinux :: ServerType dat => dat -> IO (Maybe ServerOS) detectLinux dat = do - (_code,_out,_) <- cmd dat "cat" ["/etc/lsb-release"] [] + let cmd = stCmd + c@(_code,_out,_) <- cmd dat "cat" ["/etc/lsb-release"] [] if _code == ExitSuccess then do let tag = "DISTRIB_RELEASE=" diff --git a/hspec-server.cabal b/hspec-server.cabal --- a/hspec-server.cabal +++ b/hspec-server.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: hspec-server -version: 0.2.2 +version: 0.3.0 synopsis: Test Framework for Server's status description: Hspec-Server is test framework for checking server's status. It is inspired by the Ruby library ServerSpec. @@ -49,7 +49,7 @@ build-depends: base , hspec - -- , hspec-contrib + , hspec-contrib , hspec-server , transformers Default-Language: Haskell2010 diff --git a/test/test.hs b/test/test.hs --- a/test/test.hs +++ b/test/test.hs @@ -1,25 +1,23 @@ -import Test.Hspec hiding (it,describe) +import Data.Monoid +import Test.Hspec import Test.Hspec.Server --- import Test.Hspec.Contrib.Retry +import Test.Hspec.Contrib.Retry import Control.Monad.IO.Class main :: IO () main = hspec $ do - serverSpec localhost $ do - describe "hoge" $ do + describe "hoge" $ with localhost $ do it "package test" $ do - dat <- getServerData - os <- liftIO $ detectOS dat - liftIO $ os `shouldBe` (Just $ Ubuntu "14.04") + os <- getServerOS + liftIO $ os `shouldBe` (Just $ Ubuntu "12.04") it "package test" $ do - package "zookeeper" `includes` Installed + package "zookeeper" @>= Installed it "port test" $ do - port 2181 `includes` Listening + port 2181 @>= Listening it "service test" $ do - service "cron" `includes` Running - service "atd" `includes` Running + service "zookeeper" @>= Running it "command test" $ do - command "ls" [] [] `includes` Exit 0 - -- it "retry test" $ do - -- retryWith 10 $ --currently does not support Retry. I want to use retryWith !!! - -- command "ls" [] [] `includes` Exit 0 + command "echo" ["hoge"] [] @>= Exit 0 <> Stdout "hoge\n" + it "retry test" $ do + retryWith 10 $ + command "ls" [] [] @>= Exit 0