hspec-server 0.2.2 → 0.3.0

raw patch · 6 files changed

+148/−130 lines, 6 filesdep +hspec-contribPVP ok

version bump matches the API change (PVP)

Dependencies added: hspec-contrib

API changes (from Hackage documentation)

Files

• Test/Hspec/Server/Command.hs +72/−27
• Test/Hspec/Server/Core.hs +16/−42
• Test/Hspec/Server/ServerType.hs +27/−15
• Test/Hspec/Server/Type.hs +18/−29
• hspec-server.cabal +2/−2
• test/test.hs +13/−15

@@ -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

@@ -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 @== 

@@ -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 

@@ -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="

@@ -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

@@ -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