hspec-server 0.3.2 → 0.4.0
raw patch · 13 files changed
+421/−287 lines, 13 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
- Test.Hspec.Server.Command: command :: ServerType dat => FilePath -> [String] -> String -> ServerExample dat CommandStatus
- Test.Hspec.Server.Command: package :: ServerType dat => String -> ServerExample dat ServerStatus
- Test.Hspec.Server.Command: port :: ServerType dat => Int -> ServerExample dat ServerStatus
- Test.Hspec.Server.Command: process :: ServerType dat => String -> ServerExample dat ServerStatus
- Test.Hspec.Server.Command: service :: ServerType dat => String -> ServerExample dat ServerStatus
- Test.Hspec.Server.Type: AutoDetect :: ServerOS
- Test.Hspec.Server.Type: CAnd :: (Set CommandStatus) -> CommandStatus
- Test.Hspec.Server.Type: CNone :: CommandStatus
- Test.Hspec.Server.Type: CentOS :: String -> ServerOS
- Test.Hspec.Server.Type: Debian :: String -> ServerOS
- Test.Hspec.Server.Type: Enabled :: ServerStatus
- Test.Hspec.Server.Type: Exit :: Int -> CommandStatus
- Test.Hspec.Server.Type: Fedora :: String -> ServerOS
- Test.Hspec.Server.Type: FreeBSD :: String -> ServerOS
- Test.Hspec.Server.Type: Installed :: ServerStatus
- Test.Hspec.Server.Type: LinuxOther :: String -> ServerOS
- Test.Hspec.Server.Type: Listening :: ServerStatus
- Test.Hspec.Server.Type: MacOS :: String -> ServerOS
- Test.Hspec.Server.Type: None :: ServerStatus
- Test.Hspec.Server.Type: OtherOS :: String -> ServerOS
- Test.Hspec.Server.Type: Redhat :: String -> ServerOS
- Test.Hspec.Server.Type: Running :: ServerStatus
- Test.Hspec.Server.Type: SAnd :: (Set ServerStatus) -> ServerStatus
- Test.Hspec.Server.Type: Stderr :: String -> CommandStatus
- Test.Hspec.Server.Type: Stdout :: String -> CommandStatus
- Test.Hspec.Server.Type: Ubuntu :: String -> ServerOS
- Test.Hspec.Server.Type: Windows :: String -> ServerOS
- Test.Hspec.Server.Type: class ServerType a
- Test.Hspec.Server.Type: class (Eq a, Show a) => Sets a
- Test.Hspec.Server.Type: data CommandStatus
- Test.Hspec.Server.Type: data ServerOS
- Test.Hspec.Server.Type: data ServerStatus
- Test.Hspec.Server.Type: detectLinux :: ServerType dat => dat -> IO (Maybe ServerOS)
- Test.Hspec.Server.Type: detectOS :: ServerType dat => dat -> IO (Maybe ServerOS)
- Test.Hspec.Server.Type: getStderr :: CommandStatus -> Maybe String
- Test.Hspec.Server.Type: getStdout :: CommandStatus -> Maybe String
- Test.Hspec.Server.Type: include :: Sets a => a -> a -> Bool
- Test.Hspec.Server.Type: instance Eq CommandStatus
- Test.Hspec.Server.Type: instance Eq ServerOS
- Test.Hspec.Server.Type: instance Eq ServerStatus
- Test.Hspec.Server.Type: instance Monoid CommandStatus
- Test.Hspec.Server.Type: instance Monoid ServerStatus
- Test.Hspec.Server.Type: instance Ord CommandStatus
- Test.Hspec.Server.Type: instance Ord ServerStatus
- Test.Hspec.Server.Type: instance ServerType dat => Example (ServerExample dat ())
- Test.Hspec.Server.Type: instance Sets CommandStatus
- Test.Hspec.Server.Type: instance Sets ServerStatus
- Test.Hspec.Server.Type: instance Show CommandStatus
- Test.Hspec.Server.Type: instance Show ServerOS
- Test.Hspec.Server.Type: instance Show ServerStatus
- Test.Hspec.Server.Type: stCmd :: ServerType a => a -> FilePath -> [String] -> String -> IO (ExitCode, String, String)
- Test.Hspec.Server.Type: stName :: ServerType a => a -> ServerName
- Test.Hspec.Server.Type: stOS :: ServerType a => a -> Maybe ServerOS
- Test.Hspec.Server.Type: stSetup :: ServerType a => a -> IO a
- Test.Hspec.Server.Type: type ServerExample dat = ReaderT dat IO
- Test.Hspec.Server.Type: type ServerName = String
- Test.Hspec.Server.Type: with :: ServerType dat => dat -> SpecWith dat -> Spec
+ Test.Hspec.Server.CommandStatus: command :: ServerType dat => FilePath -> [String] -> String -> ServerExample dat CommandStatus
+ Test.Hspec.Server.CommandStatus: exit :: Int -> Set CommandStatus'
+ Test.Hspec.Server.CommandStatus: getStderr :: CommandStatus -> Maybe String
+ Test.Hspec.Server.CommandStatus: getStdout :: CommandStatus -> Maybe String
+ Test.Hspec.Server.CommandStatus: instance Eq CommandStatus'
+ Test.Hspec.Server.CommandStatus: instance Ord CommandStatus'
+ Test.Hspec.Server.CommandStatus: instance Show CommandStatus'
+ Test.Hspec.Server.CommandStatus: stderr :: String -> Set CommandStatus'
+ Test.Hspec.Server.CommandStatus: stdout :: String -> Set CommandStatus'
+ Test.Hspec.Server.CommandStatus: type CommandStatus = Set CommandStatus'
+ Test.Hspec.Server.Core: AutoDetect :: ServerOS
+ Test.Hspec.Server.Core: CentOS :: String -> ServerOS
+ Test.Hspec.Server.Core: Debian :: String -> ServerOS
+ Test.Hspec.Server.Core: Fedora :: String -> ServerOS
+ Test.Hspec.Server.Core: FreeBSD :: String -> ServerOS
+ Test.Hspec.Server.Core: LinuxOther :: String -> ServerOS
+ Test.Hspec.Server.Core: MacOS :: String -> ServerOS
+ Test.Hspec.Server.Core: OtherOS :: String -> ServerOS
+ Test.Hspec.Server.Core: Redhat :: String -> ServerOS
+ Test.Hspec.Server.Core: Ubuntu :: String -> ServerOS
+ Test.Hspec.Server.Core: Windows :: String -> ServerOS
+ Test.Hspec.Server.Core: class ServerType a
+ Test.Hspec.Server.Core: data ServerOS
+ Test.Hspec.Server.Core: detectLinux :: ServerType dat => dat -> IO (Maybe ServerOS)
+ Test.Hspec.Server.Core: detectOS :: ServerType dat => dat -> IO (Maybe ServerOS)
+ Test.Hspec.Server.Core: include :: Ord a => Set a -> Set a -> Bool
+ Test.Hspec.Server.Core: instance Eq ServerOS
+ Test.Hspec.Server.Core: instance ServerType dat => Example (ServerExample dat ())
+ Test.Hspec.Server.Core: instance Show ServerOS
+ Test.Hspec.Server.Core: none :: Set a
+ Test.Hspec.Server.Core: stCmd :: ServerType a => a -> FilePath -> [String] -> String -> IO (ExitCode, String, String)
+ Test.Hspec.Server.Core: stName :: ServerType a => a -> ServerName
+ Test.Hspec.Server.Core: stOS :: ServerType a => a -> Maybe ServerOS
+ Test.Hspec.Server.Core: stSetup :: ServerType a => a -> IO a
+ Test.Hspec.Server.Core: type ServerExample dat = ReaderT dat IO
+ Test.Hspec.Server.Core: type ServerName = String
+ Test.Hspec.Server.Core: with :: ServerType dat => dat -> SpecWith dat -> Spec
+ Test.Hspec.Server.NetworkStatus: host :: ServerType dat => String -> ServerExample dat NetworkStatus
+ Test.Hspec.Server.NetworkStatus: hostWithPort :: ServerType dat => String -> Int -> ServerExample dat NetworkStatus
+ Test.Hspec.Server.NetworkStatus: instance Eq NetworkStatus'
+ Test.Hspec.Server.NetworkStatus: instance Ord NetworkStatus'
+ Test.Hspec.Server.NetworkStatus: instance Show NetworkStatus'
+ Test.Hspec.Server.NetworkStatus: reachable :: Set NetworkStatus'
+ Test.Hspec.Server.NetworkStatus: type NetworkStatus = Set NetworkStatus'
+ Test.Hspec.Server.ServerStatus: enabled :: Set ServerStatus'
+ Test.Hspec.Server.ServerStatus: installed :: Set ServerStatus'
+ Test.Hspec.Server.ServerStatus: instance Eq ServerStatus'
+ Test.Hspec.Server.ServerStatus: instance Ord ServerStatus'
+ Test.Hspec.Server.ServerStatus: instance Show ServerStatus'
+ Test.Hspec.Server.ServerStatus: listening :: Set ServerStatus'
+ Test.Hspec.Server.ServerStatus: package :: ServerType dat => String -> ServerExample dat ServerStatus
+ Test.Hspec.Server.ServerStatus: port :: ServerType dat => Int -> ServerExample dat ServerStatus
+ Test.Hspec.Server.ServerStatus: process :: ServerType dat => String -> ServerExample dat ServerStatus
+ Test.Hspec.Server.ServerStatus: running :: Set ServerStatus'
+ Test.Hspec.Server.ServerStatus: service :: ServerType dat => String -> ServerExample dat ServerStatus
+ Test.Hspec.Server.ServerStatus: type ServerStatus = Set ServerStatus'
+ Test.Hspec.Server.Util: cmd :: ServerType dat => dat -> FilePath -> [String] -> String -> IO (ExitCode, String, String)
+ Test.Hspec.Server.Util: cmdAndChk :: ServerType dat => TestType -> s -> s -> FilePath -> Arg -> Input -> Patterns -> ServerExample dat (Either String s)
+ Test.Hspec.Server.Util: type Arg = [String]
+ Test.Hspec.Server.Util: type Input = String
+ Test.Hspec.Server.Util: type Patterns = [String]
+ Test.Hspec.Server.Util: type TestType = String
- Test.Hspec.Server.Core: (@==) :: (ServerType dat, Sets s) => ServerExample dat s -> s -> ServerExample dat ()
+ Test.Hspec.Server.Core: (@==) :: (ServerType dat, Show s, Ord s) => ServerExample dat (Set s) -> Set s -> ServerExample dat ()
- Test.Hspec.Server.Core: (@>=) :: (ServerType dat, Sets s) => ServerExample dat s -> s -> ServerExample dat ()
+ Test.Hspec.Server.Core: (@>=) :: (ServerType dat, Show s, Ord s) => ServerExample dat (Set s) -> Set s -> ServerExample dat ()
- Test.Hspec.Server.Core: includes :: (ServerType dat, Sets s) => ServerExample dat s -> s -> ServerExample dat ()
+ Test.Hspec.Server.Core: includes :: (ServerType dat, Show s, Ord s) => ServerExample dat (Set s) -> (Set s) -> ServerExample dat ()
- Test.Hspec.Server.Core: includes' :: (ServerType dat, Sets s) => s -> s -> ServerExample dat ()
+ Test.Hspec.Server.Core: includes' :: (ServerType dat, Show s, Ord s) => Set s -> Set s -> ServerExample dat ()
Files
- ChangeLog.md +9/−0
- README.md +37/−0
- Test/Hspec/Server.hs +7/−5
- Test/Hspec/Server/Command.hs +0/−106
- Test/Hspec/Server/CommandStatus.hs +57/−0
- Test/Hspec/Server/Core.hs +105/−5
- Test/Hspec/Server/NetworkStatus.hs +36/−0
- Test/Hspec/Server/ServerStatus.hs +84/−0
- Test/Hspec/Server/ServerType.hs +1/−1
- Test/Hspec/Server/Type.hs +0/−159
- Test/Hspec/Server/Util.hs +46/−0
- hspec-server.cabal +13/−5
- tests/test.hs +26/−6
+ ChangeLog.md view
@@ -0,0 +1,9 @@+## 0.4.0++* Add NetworkStatus and function for checking network-reachablity+* Change ServerStatus-Type to Data.Set ServerStatus' and Remove Sets-type-class+* Change status data-constructors like Running to lower case functions like running for removing Sets-type-class++## 0.3.2++* Support for docker
+ README.md view
@@ -0,0 +1,37 @@+# Hspec-Server: Test Framework like ServerSpec for Haskell++[](https://hackage.haskell.org/package/hspec-server) [](https://travis-ci.org/junjihashimoto/hspec-server) [](https://coveralls.io/r/junjihashimoto/hspec-server)++Hspec-Server is test framework for checking server's status.+It is inspired by the Ruby library ServerSpec.++## Getting started++Install this from Hackage.++ cabal update && cabal install hspec-server++## Usage++Put "with(ServerType)" after hspec's describe-sentence.+Currently localhost, ssh , vagrant and docker(>=1.4.1) are supported for ServerType.+Examples are below. "@>=" is like hspec's shouldBe.+it can check multiple values.++```+ describe "test for localhost" $ with localhost $ do+ it "package zookeepr" $ do+ package "zookeeper" @>= installed+ it "port test" $ do+ port 2181 @>= listening+ it "service test" $ do+ service "cron" @>= running+ it "command test" $ do+ command "echo" ["hoge"] [] @>= exit 0 <> stdout "hoge\n"+ describe "test for vagrant" $ with (vagrant "servername") $ do+ it "port test" $ do+ port 2181 @>= listening+ describe "test for docker" $ with (docker "containerId") $ do+ it "port test" $ do+ port 2181 @>= listening+```
Test/Hspec/Server.hs view
@@ -1,13 +1,15 @@ {-# LANGUAGE OverloadedStrings #-} module Test.Hspec.Server (- module Test.Hspec.Server.Type-, module Test.Hspec.Server.Core+ module Test.Hspec.Server.Core , module Test.Hspec.Server.ServerType-, module Test.Hspec.Server.Command+, module Test.Hspec.Server.ServerStatus+, module Test.Hspec.Server.CommandStatus+, module Test.Hspec.Server.NetworkStatus ) where -import Test.Hspec.Server.Type import Test.Hspec.Server.Core import Test.Hspec.Server.ServerType-import Test.Hspec.Server.Command+import Test.Hspec.Server.ServerStatus+import Test.Hspec.Server.CommandStatus+import Test.Hspec.Server.NetworkStatus
− Test/Hspec/Server/Command.hs
@@ -1,106 +0,0 @@-module Test.Hspec.Server.Command (- package-, process-, service-, port-, command- )where--import System.Exit-import Control.Monad-import Control.Monad.IO.Class-import Data.Monoid-import Text.Regex.Posix-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- 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- dat <- getServerData- (code,_,_) <- liftIO $ cmd dat "pgrep" [ps] []- if code == ExitSuccess- then return Running- else return None--service :: ServerType dat => String -> ServerExample dat ServerStatus-service s = do- dat <- getServerData- (_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- 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- dat <- getServerData- (code,out,err) <- liftIO $ cmd dat c arg inp- let genCode ExitSuccess = 0- genCode (ExitFailure val) = val- return $ Exit (genCode code) <> Stdout out <> Stderr err
+ Test/Hspec/Server/CommandStatus.hs view
@@ -0,0 +1,57 @@+module Test.Hspec.Server.CommandStatus (+ CommandStatus+, exit+, stdout+, stderr+, getStdout+, getStderr+, command+) where++import System.Exit+import Control.Monad.IO.Class+import Data.Monoid+import Test.Hspec.Server.Core+import Test.Hspec.Server.Util+import qualified Data.Set as S++type CommandStatus = S.Set CommandStatus'+data CommandStatus' =+ Exit Int+ | Stdout String+ | Stderr String+ deriving (Show,Ord,Eq)++exit :: Int -> S.Set CommandStatus'+exit n = S.singleton (Exit n)+stdout :: String -> S.Set CommandStatus'+stdout str = S.singleton (Stdout str)+stderr :: String -> S.Set CommandStatus'+stderr str = S.singleton (Stderr str)++getStdout :: CommandStatus -> Maybe String+getStdout stat = get (S.toList stat)+ where + get [] = Nothing+ get (x:xs) = + case x of+ Stdout str -> Just str+ _ -> get xs++getStderr :: CommandStatus -> Maybe String+getStderr stat = get (S.toList stat)+ where + get [] = Nothing+ get (x:xs) = + case x of+ Stderr str -> Just str+ _ -> get xs+++command :: ServerType dat => FilePath -> [String] -> String -> ServerExample dat CommandStatus+command c arg inp = do+ dat <- getServerData+ (code,out,err) <- liftIO $ cmd dat c arg inp+ let genCode ExitSuccess = 0+ genCode (ExitFailure val) = val+ return $ exit (genCode code) <> stdout out <> stderr err
Test/Hspec/Server/Core.hs view
@@ -1,12 +1,112 @@+{-# LANGUAGE TypeFamilies, FlexibleInstances, TypeSynonymInstances, DeriveDataTypeable #-} module Test.Hspec.Server.Core where +import System.Exit+import Control.Monad.Trans.Reader+import qualified Test.Hspec.Core.Spec as Hspec+import Test.Hspec (before)++import Control.Monad+import Data.List+import Data.Maybe+import qualified Data.Set as S+ import qualified Test.Hspec as Hspec import qualified Test.HUnit as HUnit import Control.Monad.IO.Class import Control.Monad.Trans.Reader-import Test.Hspec.Server.Type+import qualified Data.Set as S +data ServerOS =+ Ubuntu String+ | Debian String+ | CentOS String+ | Fedora String+ | Redhat String+ | LinuxOther String+ | FreeBSD String+ | MacOS String+ | Windows String+ | OtherOS String+ | AutoDetect+ deriving (Show,Eq)++type ServerName = String++class ServerType a where+ stSetup :: a -> IO a+ stOS :: a -> Maybe ServerOS+ stName :: a -> ServerName+ stCmd :: a -> FilePath -> [String] -> String -> IO (ExitCode,String,String)++type ServerExample dat = ReaderT dat IO++with :: ServerType dat => dat -> Hspec.SpecWith dat -> Hspec.Spec+with d = before (stSetup d)++instance (ServerType dat) => Hspec.Example (ServerExample dat ()) where+ type Arg (ServerExample dat ()) = dat+ evaluateExample example params action =+ Hspec.evaluateExample+ (action $ runReaderT example)+ params+ ($ ())++include :: Ord a => S.Set a -> S.Set a -> Bool+include a b = S.isSubsetOf b a+none :: S.Set a+none = S.empty++detectOS :: ServerType dat => dat -> IO (Maybe ServerOS)+detectOS dat = do+ v@(code,out,_) <- stCmd dat "bash" ["-c","echo $OSTYPE"] []+ when (code /= ExitSuccess) $ do+ error $ "detectOS's error;" ++ show v+ case listToMaybe (lines out) of+ Just str -> checkEnv str+ Nothing -> return Nothing+ where+ checkEnv str = + case str of+ "linux-gnu" -> detectLinux dat+ 'd':'a':'r':'w':'i':'n':o -> return $ Just $ MacOS o+ "msys" -> return $ Just $ Windows "msys"+ "cygwin" -> return $ Just $ Windows "cygwin"+ "win32" -> return $ Just $ Windows "win32"+ "win64" -> return $ Just $ Windows "win64"+ 'f':'r':'e':'e':'b':'s':'d':o -> return $ Just $ FreeBSD o+ o -> return $ Just $ OtherOS o++detectLinux :: ServerType dat => dat -> IO (Maybe ServerOS)+detectLinux dat = do+ let cmd = stCmd+ (_code,_out,_) <- cmd dat "cat" ["/etc/lsb-release"] []+ if _code == ExitSuccess+ then do+ let tag = "DISTRIB_RELEASE="+ let v = listToMaybe $ map (drop (length tag)) $ filter (isPrefixOf "DISTRIB_RELEASE=") (lines _out)+ case v of+ Just v' -> return $ Just $ Ubuntu v'+ Nothing -> return $ Just $ Ubuntu ""+ else do+ (_code,_out,_) <- cmd dat "cat" ["/etc/debian_version"] []+ if _code == ExitSuccess+ then return $ Just $ Debian _out+ else do+ (_code,_out,_) <- cmd dat "cat" ["/etc/centos-release"] []+ if _code == ExitSuccess+ then return $ Just $ CentOS _out+ else do+ (_code,_out,_) <- cmd dat "cat" ["/etc/fedora-release"] []+ if _code == ExitSuccess+ then return $ Just $ Fedora _out+ else do+ (_code,_out,_) <- cmd dat "cat" ["/etc/redhat-release"] []+ if _code == ExitSuccess+ then return $ Just $ Fedora _out+ else return $ Just $ LinuxOther ""+ getServerData :: ServerType dat => ServerExample dat dat getServerData = ask @@ -15,23 +115,23 @@ d <- ask return $ stOS d -includes' :: (ServerType dat, Sets s) => s -> s -> ServerExample dat ()+includes' :: (ServerType dat,Show s,Ord s) => S.Set s -> S.Set s -> ServerExample dat () includes' org ex = liftIO $ flip HUnit.assertBool (include org ex) $ concat [ "Expected status was ", show ex , " but received status was ", show org ] -includes :: (ServerType dat, Sets s) => ServerExample dat s -> s -> ServerExample dat ()+includes :: (ServerType dat,Show s,Ord s) => ServerExample dat (S.Set s) -> (S.Set s) -> ServerExample dat () includes org' ex = do org <- org' org `includes'` ex -(@>=) :: (ServerType dat, Sets s) => ServerExample dat s -> s -> ServerExample dat ()+(@>=) :: (ServerType dat,Show s,Ord s) => ServerExample dat (S.Set s) -> S.Set s -> ServerExample dat () (@>=) = includes infix 1 @>= -(@==) :: (ServerType dat, Sets s) => ServerExample dat s -> s -> ServerExample dat ()+(@==) :: (ServerType dat,Show s,Ord s) => ServerExample dat (S.Set s) -> S.Set s -> ServerExample dat () (@==) org' ex = do org <- org' liftIO $ Hspec.shouldBe org ex
+ Test/Hspec/Server/NetworkStatus.hs view
@@ -0,0 +1,36 @@+module Test.Hspec.Server.NetworkStatus (+ NetworkStatus+, reachable+, host+, hostWithPort+) where++import System.Exit+import Control.Monad.IO.Class+import Test.Hspec.Server.Core+import Test.Hspec.Server.Util+import qualified Data.Set as S++type NetworkStatus = S.Set NetworkStatus'+data NetworkStatus' =+ Reachable+ deriving (Show,Ord,Eq)++reachable :: S.Set NetworkStatus'+reachable = S.singleton Reachable++host :: ServerType dat => String -> ServerExample dat NetworkStatus+host hostname = do+ dat <- getServerData+ (code,_,_) <- liftIO $ cmd dat "ping" ["-c","1",hostname] []+ if code == ExitSuccess+ then return reachable+ else return none++hostWithPort :: ServerType dat => String -> Int -> ServerExample dat NetworkStatus+hostWithPort hostname port = do+ dat <- getServerData+ (code,_,_) <- liftIO $ cmd dat "nc" [hostname,show port] []+ if code == ExitSuccess+ then return reachable+ else return none
+ Test/Hspec/Server/ServerStatus.hs view
@@ -0,0 +1,84 @@+module Test.Hspec.Server.ServerStatus (+ ServerStatus+, installed+, running+, enabled+, listening+, package+, process+, service+, port+) where++import System.Exit+import Control.Monad+import Control.Monad.IO.Class+import Data.Monoid+import Text.Regex.Posix+import Test.Hspec.Server.Core+import Test.Hspec.Server.Util+import qualified Data.Set as S++type ServerStatus = S.Set ServerStatus'+data ServerStatus' =+ Installed+ | Enabled+ | Running+ | Listening+ deriving (Show,Ord,Eq)++installed :: S.Set ServerStatus'+installed = S.singleton Installed+running :: S.Set ServerStatus'+running = S.singleton Running+enabled :: S.Set ServerStatus'+enabled = S.singleton Enabled+listening :: S.Set ServerStatus'+listening = S.singleton Listening+++package :: ServerType dat => String -> ServerExample dat ServerStatus+package pkg = do+ 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+ dat <- getServerData+ (code,_,_) <- liftIO $ cmd dat "pgrep" [ps] []+ if code == ExitSuccess+ then return running+ else return none++service :: ServerType dat => String -> ServerExample dat ServerStatus+service s = do+ dat <- getServerData+ (_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+ 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+
Test/Hspec/Server/ServerType.hs view
@@ -7,7 +7,7 @@ import Data.Monoid import Data.Maybe import Control.Monad-import Test.Hspec.Server.Type+import Test.Hspec.Server.Core data Localhost = Localhost { lOS :: !(Maybe ServerOS)
− Test/Hspec/Server/Type.hs
@@ -1,159 +0,0 @@-{-# LANGUAGE CPP, TypeFamilies, FlexibleInstances, TypeSynonymInstances, DeriveDataTypeable #-}-module Test.Hspec.Server.Type where--import System.Exit-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-import Data.List-import Data.Maybe-import qualified Data.Set as S--data ServerOS =- Ubuntu String- | Debian String- | CentOS String- | Fedora String- | Redhat String- | LinuxOther String- | FreeBSD String- | MacOS String- | Windows String- | OtherOS String- | AutoDetect- deriving (Show,Eq)--type ServerName = String--class ServerType a where- stSetup :: a -> IO a- stOS :: a -> Maybe ServerOS- stName :: a -> ServerName- stCmd :: a -> FilePath -> [String] -> String -> IO (ExitCode,String,String)--type ServerExample dat = ReaderT dat IO--with :: ServerType dat => dat -> Hspec.SpecWith dat -> Hspec.Spec-with d = before (stSetup d)--instance (ServerType dat) => Hspec.Example (ServerExample dat ()) where- type Arg (ServerExample dat ()) = dat- evaluateExample example params action =- Hspec.evaluateExample- (action $ runReaderT example)- params- ($ ())--class (Eq a ,Show a) => Sets a where- include :: a -> a -> Bool--data ServerStatus =- SAnd (S.Set ServerStatus)- | Installed- | Enabled- | Running- | Listening- | None- deriving (Show,Ord,Eq)--instance Monoid ServerStatus where- mempty = None- mappend None a = a- mappend a None = a- mappend (SAnd a) (SAnd b) = SAnd (a<>b)- mappend (SAnd a) b = SAnd (a <> S.singleton b)- mappend a (SAnd b) = SAnd (S.singleton a <> b)- mappend a b = SAnd (S.singleton a <> S.singleton b)--data CommandStatus =- CAnd (S.Set CommandStatus)- | Exit Int- | Stdout String- | Stderr String- | CNone- deriving (Show,Ord,Eq)--instance Monoid CommandStatus where- mempty = CNone- mappend CNone a = a- mappend a CNone = a- mappend (CAnd a) (CAnd b) = CAnd (a<>b)- mappend (CAnd a) b = CAnd (a <> S.singleton b)- mappend a (CAnd b) = CAnd (S.singleton a <> b)- mappend a b = CAnd (S.singleton a <> S.singleton b)--instance Sets ServerStatus where- include (SAnd org') (SAnd exp') = flip S.isSubsetOf org' exp'- include org' (SAnd exp') = flip S.isSubsetOf (S.singleton org') exp'- include (SAnd org') exp' = flip S.isSubsetOf org' (S.singleton exp')- include org' exp' = flip S.isSubsetOf (S.singleton org') (S.singleton exp')--instance Sets CommandStatus where- include (CAnd org') (CAnd exp') = flip S.isSubsetOf org' exp'- include org' (CAnd exp') = flip S.isSubsetOf (S.singleton org') exp'- include (CAnd org') exp' = flip S.isSubsetOf org' (S.singleton exp')- include org' exp' = flip S.isSubsetOf (S.singleton org') (S.singleton exp')--getStdout :: CommandStatus -> Maybe String-getStdout (Stdout code) = Just code-getStdout (CAnd statuss) = listToMaybe $ mapMaybe getStdout $ S.toList statuss-getStdout _ = Nothing--getStderr :: CommandStatus -> Maybe String-getStderr (Stderr code) = Just code-getStderr (CAnd statuss) = listToMaybe $ mapMaybe getStdout $ S.toList statuss-getStderr _ = Nothing---detectOS :: ServerType dat => dat -> IO (Maybe ServerOS)-detectOS dat = do- v@(code,out,_) <- stCmd dat "bash" ["-c","echo $OSTYPE"] []- when (code /= ExitSuccess) $ do- error $ "detectOS's error;" ++ show v- case listToMaybe (lines out) of- Just str -> checkEnv str- Nothing -> return Nothing- where- checkEnv str = - case str of- "linux-gnu" -> detectLinux dat- 'd':'a':'r':'w':'i':'n':o -> return $ Just $ MacOS o- "msys" -> return $ Just $ Windows "msys"- "cygwin" -> return $ Just $ Windows "cygwin"- "win32" -> return $ Just $ Windows "win32"- "win64" -> return $ Just $ Windows "win64"- 'f':'r':'e':'e':'b':'s':'d':o -> return $ Just $ FreeBSD o- o -> return $ Just $ OtherOS o--detectLinux :: ServerType dat => dat -> IO (Maybe ServerOS)-detectLinux dat = do- let cmd = stCmd- c@(_code,_out,_) <- cmd dat "cat" ["/etc/lsb-release"] []- if _code == ExitSuccess- then do- let tag = "DISTRIB_RELEASE="- let v = listToMaybe $ map (drop (length tag)) $ filter (isPrefixOf "DISTRIB_RELEASE=") (lines _out)- case v of- Just v' -> return $ Just $ Ubuntu v'- Nothing -> return $ Just $ Ubuntu ""- else do- (_code,_out,_) <- cmd dat "cat" ["/etc/debian_version"] []- if _code == ExitSuccess- then return $ Just $ Debian _out- else do- (_code,_out,_) <- cmd dat "cat" ["/etc/centos-release"] []- if _code == ExitSuccess- then return $ Just $ CentOS _out- else do- (_code,_out,_) <- cmd dat "cat" ["/etc/fedora-release"] []- if _code == ExitSuccess- then return $ Just $ Fedora _out- else do- (_code,_out,_) <- cmd dat "cat" ["/etc/redhat-release"] []- if _code == ExitSuccess- then return $ Just $ Fedora _out- else return $ Just $ LinuxOther ""
+ Test/Hspec/Server/Util.hs view
@@ -0,0 +1,46 @@+module Test.Hspec.Server.Util where++import System.Exit+import Control.Monad+import Control.Monad.IO.Class+import Data.Monoid+import Text.Regex.Posix+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)+ => 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+ (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
hspec-server.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: hspec-server-version: 0.3.2+version: 0.4.0 synopsis: Test Framework for checking server's status description: Hspec-Server is test framework for checking server's status. It is inspired by the Ruby library ServerSpec.@@ -16,16 +16,24 @@ -- extra-source-files: cabal-version: >=1.10 +bug-reports: https://github.com/junjihashimoto/hspec-server/issues++extra-source-files:+ ChangeLog.md+ README.md+ source-repository head- type: git- location: https://github.com/junjihashimoto/hspec-server.git+ type: git+ location: https://github.com/junjihashimoto/hspec-server.git library exposed-modules: Test.Hspec.Server- , Test.Hspec.Server.Type , Test.Hspec.Server.Core , Test.Hspec.Server.ServerType- , Test.Hspec.Server.Command+ , Test.Hspec.Server.ServerStatus+ , Test.Hspec.Server.NetworkStatus+ , Test.Hspec.Server.CommandStatus+ , Test.Hspec.Server.Util -- other-modules: -- other-extensions: build-depends: base >=4.6 && <5
tests/test.hs view
@@ -3,21 +3,41 @@ import Test.Hspec.Server import Test.Hspec.Contrib.Retry import Control.Monad.IO.Class+import Control.Monad.Trans.Reader main :: IO () main = hspec $ do describe "hoge" $ with localhost $ do- it "package test" $ do+ it "check os" $ do os <- getServerOS liftIO $ os `shouldBe` (Just $ Ubuntu "12.04")+ it "process test" $ do+ process "java" @>= running+ process "hoge" @>= none it "package test" $ do- package "zookeeper" @>= Installed+ package "zookeeper" @>= installed+ liftIO $ do+ runReaderT (package "zookeeper-hoge") localhost `shouldThrow` anyException -- Handling exception is not good. Should change it "port test" $ do- port 2181 @>= Listening+ port 2181 @>= listening+ port 2180 @>= none it "service test" $ do- service "zookeeper" @>= Running+ service "zookeeper" @>= running+ liftIO $ do+ runReaderT (service "zookeeper-hoge") localhost `shouldThrow` anyException -- Handling exception is not good. Should change it "command test" $ do- command "echo" ["hoge"] [] @>= Exit 0 <> Stdout "hoge\n"+ command "bash" ["-c","exit 2"] [] @>= exit 2+ command "echo" ["hoge"] [] @>= exit 0 <> stdout "hoge\n"+ v <- command "echo" ["hoge"] []+ v `includes'` (exit 0 <> stdout "hoge\n")+ liftIO $ getStdout v `shouldBe` Just "hoge\n"+ liftIO $ getStderr v `shouldBe` Just "" it "retry test" $ do retryWith 10 $- command "ls" [] [] @>= Exit 0+ command "ls" [] [] @>= exit 0+ it "network" $ do+ host "localhost" @>= reachable+ host "localhost" @== reachable+ hostWithPort "localhost" 2181 @>= reachable+ host "hogehoge" @>= none+ hostWithPort "hogehoge" 2181 @>= none