packages feed

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 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++[![Hackage version](https://img.shields.io/hackage/v/hspec-server.svg?style=flat)](https://hackage.haskell.org/package/hspec-server)  [![Build Status](https://travis-ci.org/junjihashimoto/hspec-server.png?branch=master)](https://travis-ci.org/junjihashimoto/hspec-server) [![Coverage Status](https://coveralls.io/repos/junjihashimoto/hspec-server/badge.png)](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