hspec-server 0.1.0.0 → 0.2.0

raw patch · 7 files changed

+382/−220 lines, 7 filesdep +hspec-contribdep +hspec-expectationsPVP ok

version bump matches the API change (PVP)

Dependencies added: hspec-contrib, hspec-expectations

API changes (from Hackage documentation)

Files

• Test/Hspec/Server.hs +11/−213
• Test/Hspec/Server/Command.hs +54/−0
• Test/Hspec/Server/Core.hs +64/−0
• Test/Hspec/Server/ServerType.hs +64/−0
• Test/Hspec/Server/Type.hs +162/−0
• hspec-server.cabal +12/−1
• test/test.hs +15/−6

@@ -1,215 +1,13 @@ {-# LANGUAGE OverloadedStrings #-}-module Test.Hspec.Server where--import System.Process-import System.Exit-import System.IO-import qualified Test.Hspec.Core.Spec as Hspec-import qualified Test.HUnit as HUnit-import qualified Control.Monad.Trans.State as ST-import Control.Monad.Trans.Writer-import Control.Monad.IO.Class-import System.IO.Temp--import Data.Monoid-import qualified Data.Set as S-import Text.Regex.Posix---data ServerOS =-   Ubuntu String- | Debian String- | FreeBSD String- | MacOS String- | Windows String- | OtherOS String-   deriving (Show,Eq)--type ServerName = String--class ServerType a where-  name :: a -> ServerName-  cmd :: a -> FilePath -> [String] -> String -> IO (ExitCode,String,String)--data Localhost = Localhost deriving (Show,Eq)--localhost :: Localhost-localhost = Localhost--data Ssh = Ssh {-  sshHostName :: String-, sshId :: Maybe String-, sshConf :: Maybe String-, sshPort :: Maybe Int-, sshUser :: Maybe String-} deriving (Show,Eq)--ssh :: String -> Ssh-ssh hostname = Ssh hostname Nothing Nothing Nothing Nothing--data Vagrant = Vagrant {-  vHostName :: String-} deriving (Show,Eq)--vagrant :: String -> Vagrant-vagrant hostname = Vagrant hostname--instance ServerType Localhost where-  name _ = "localhost"-  cmd _ = readProcessWithExitCode--instance ServerType Ssh where-  name = sshHostName-  cmd d c arg i = do-    readProcessWithExitCode "ssh" (sshOpt ++ [sshHost] ++ [c] ++ arg) i-    where-      sshOpt =-        (maybe [] (\v-> ["-p",show v]) (sshPort d)) ++-        (maybe [] (\v-> ["-i",show v]) (sshId d)) ++-        (maybe [] (\v-> ["-F",show v]) (sshConf d))-      sshHost = (maybe "" (\v -> v <> "@") (sshUser d)) <> sshHostName d--instance ServerType Vagrant where-  name = vHostName-  cmd d c arg i = withSystemTempFile "hspec-server" $ \file handle -> do-    (_,conf,_) <- readProcessWithExitCode "vagrant" ["ssh-config"] []-    hPutStr handle conf-    hClose handle-    readProcessWithExitCode "ssh" (["-F",file,name d,c]++arg) i--data ServerExampleData dat = ServerExampleData {-    serverData :: !dat-  , serverOS :: !ServerOS-  }--type ServerExample dat = ST.StateT (ServerExampleData dat) IO--type ServerSpec dat = Writer [ServerSpecTree dat] ()--data ServerSpecTree dat-    = ServerSpecGroup String [ServerSpecTree dat]-    | ServerSpecItem String (ServerExample dat ())--detectOS :: ServerType dat => dat -> IO (Maybe ServerOS)-detectOS _dat = return $ Just $ Ubuntu "precise"--getServerData :: ServerType dat => ServerExample dat dat-getServerData = fmap serverData ST.get--sdescribe :: ServerType dat => String -> ServerSpec dat -> ServerSpec dat-sdescribe label sspecs = tell [ServerSpecGroup label $ execWriter sspecs]--serverSpecOS :: ServerType dat-           => dat-           -> ServerOS-           -> ServerSpec dat-           -> Hspec.Spec-serverSpecOS serverData' serverOS' sspecs =-    Hspec.fromSpecList $ map unServer $ execWriter sspecs-  where-    unServer (ServerSpecGroup x y) = Hspec.specGroup x $ map unServer y-    unServer (ServerSpecItem x y) = Hspec.specItem x $ -        ST.evalStateT y ServerExampleData {-            serverData = serverData'-          , serverOS = serverOS'-         }--serverSpec :: ServerType dat-           => dat-           -> ServerSpec dat-           -> Hspec.Spec-serverSpec serverData' sspecs = do-  serverOS' <- Hspec.runIO $ detectOS serverData'-  case serverOS' of-    Just os' -> serverSpecOS serverData' os' sspecs-    Nothing -> error "can not detect os"---sit :: ServerType dat => String -> ServerExample dat () -> ServerSpec dat-sit label example = tell [ServerSpecItem label example]--data ServerStatus =-   SAnd (S.Set ServerStatus)- | Installed- | Enabled- | Running- | Listening- | Exit Int- | Stdout String- | Stderr String- | 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)---includes' :: ServerType dat => ServerStatus -> ServerStatus -> ServerExample dat ()-includes' org ex =-  liftIO $ flip HUnit.assertBool (includes'' org ex) $ concat-    [ "Expected status was ", show ex-    , " but received status was ", show org-    ]-  where-    includes'' :: ServerStatus -> ServerStatus -> Bool-    includes'' (SAnd org') (SAnd exp') = flip S.isSubsetOf org' exp'-    includes'' org' (SAnd exp') = flip S.isSubsetOf (S.singleton org') exp'-    includes'' (SAnd org') exp' = flip S.isSubsetOf org' (S.singleton exp')-    includes'' org' exp' = flip S.isSubsetOf (S.singleton org') (S.singleton exp')--includes :: ServerType dat => ServerExample dat ServerStatus -> ServerStatus -> ServerExample dat ()-includes org' ex = do-  org <- org'-  org `includes'` ex--package :: ServerType dat => String -> ServerExample dat ServerStatus-package pkg = do-  dat <- getServerData-  (_,out,_) <- liftIO $ cmd dat "dpkg" ["-l",pkg] []-  if or (map (\v -> v  =~ ("^ii +" <> pkg <> " ")) (lines out))-    then return Installed-    else return None--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-  (_,out,_) <- liftIO $ cmd dat ("/etc/init.d/"++s) ["status"] []-  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-  (_,out,_) <- liftIO $ cmd dat "netstat" ["-tanp"] []-  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+module Test.Hspec.Server (+  module Test.Hspec.Server.Type+, module Test.Hspec.Server.Core+, module Test.Hspec.Server.ServerType+, module Test.Hspec.Server.Command+  )+where -command :: ServerType dat => FilePath -> [String] -> String -> ServerExample dat ServerStatus-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+import Test.Hspec.Server.Type+import Test.Hspec.Server.Core+import Test.Hspec.Server.ServerType+import Test.Hspec.Server.Command

@@ -0,0 +1,54 @@+module Test.Hspec.Server.Command where++import System.Exit+import Control.Monad.IO.Class+import Data.Monoid+import Text.Regex.Posix+import Test.Hspec.Server.Type+import Test.Hspec.Server.Core++package :: ServerType dat => String -> ServerExample dat ServerStatus+package pkg = do+  dat <- getServerData+  (_,out,_) <- liftIO $ cmd dat "dpkg" ["-l",pkg] []+  if or (map (\v -> v  =~ ("^ii +" <> pkg <> " ")) (lines out))+    then return Installed+    else return None++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+  (_,out,_) <- liftIO $ cmd dat ("/etc/init.d/"++s) ["status"] []+  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+  (_,out,_) <- liftIO $ cmd dat "netstat" ["-tanp"] []+  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++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

@@ -0,0 +1,64 @@++module Test.Hspec.Server.Core where++import qualified Test.Hspec.Core.Spec 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 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]++describe :: ServerType dat => String -> ServerSpec dat -> ServerSpec dat+describe label sspecs = tell [ServerSpecGroup label $ execWriter sspecs]++includes' :: (ServerType dat, Sets s) => s -> 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 org' ex = do+  org <- org'+  org `includes'` ex+

@@ -0,0 +1,64 @@+module Test.Hspec.Server.ServerType where++import System.Process+import System.Exit+import System.IO.Temp+import System.IO+import Data.Monoid+import Data.Maybe+import Control.Monad+import Test.Hspec.Server.Type++data Localhost = Localhost deriving (Show,Eq)++localhost :: Localhost+localhost = Localhost++instance ServerType Localhost where+  setup a = return a+  name _ = "localhost"+  cmd _ = readProcessWithExitCode++data Ssh = Ssh {+  sshHostName :: String+, sshId :: Maybe String+, sshConf :: Maybe String+, sshPort :: Maybe Int+, sshUser :: Maybe String+} deriving (Show,Eq)++ssh :: String -> Ssh+ssh hostname = Ssh hostname Nothing Nothing Nothing Nothing++instance ServerType Ssh where+  setup a = return a+  name = sshHostName+  cmd d c arg i = do+    readProcessWithExitCode "ssh" (sshOpt ++ [sshHost] ++ [c] ++ arg) i+    where+      sshOpt =+        (maybe [] (\v-> ["-p",show v]) (sshPort d)) +++        (maybe [] (\v-> ["-i",show v]) (sshId d)) +++        (maybe [] (\v-> ["-F",show v]) (sshConf d))+      sshHost = (maybe "" (\v -> v <> "@") (sshUser d)) <> sshHostName d++data Vagrant = Vagrant {+   vHostName :: String+ , vConf :: Maybe String+} deriving (Show,Eq)++vagrant :: String -> Vagrant+vagrant hostname = Vagrant hostname Nothing++instance ServerType Vagrant where+  setup a = do+    (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+    hPutStr handle (fromJust (vConf d))+    hClose handle+    readProcessWithExitCode "ssh" (["-F",file,name d,c]++arg) i+

@@ -0,0 +1,162 @@+{-# LANGUAGE CPP, TypeFamilies, FlexibleInstances, TypeSynonymInstances, DeriveDataTypeable #-}+module Test.Hspec.Server.Type where++import System.Exit+import qualified Control.Monad.Trans.State as ST+import Control.Monad.Trans.Writer+import qualified Test.Hspec.Core.Spec as Hspec++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+  setup :: a -> IO a+  name :: a -> ServerName+  cmd :: a -> FilePath -> [String] -> String -> IO (ExitCode,String,String)++data ServerExampleData dat = ServerExampleData {+    serverData :: !dat+  , serverOS :: !ServerOS+  }++type ServerExample dat = ST.StateT (ServerExampleData dat) IO++instance (ServerType dat) => Hspec.Example (ServerExample dat a) where+  type Arg (ServerExample dat a) = dat+  evaluateExample example params action =+    Hspec.evaluateExample+      (action $ \dat' -> do+        os <- detectOS dat'+        _ <- ST.evalStateT example ServerExampleData {+            serverData = dat'+          , serverOS = fromJust os+          }+        return ())+      params+      ($ ())++type ServerSpec dat = Writer [ServerSpecTree dat] ()++data ServerSpecTree dat+    = ServerSpecGroup String [ServerSpecTree dat]+    | ServerSpecItem String (ServerExample dat ())++class 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 $ catMaybes $ map 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 _ = Nothing+++detectOS :: ServerType dat => dat -> IO (Maybe ServerOS)+detectOS dat = do+  (_,out,_) <- cmd dat "sh" ["-c","echo $OSTYPE"] []+  case (head (lines out)) 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+  (_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 ""

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                hspec-server-version:             0.1.0.0+version:             0.2.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.@@ -16,13 +16,22 @@ -- extra-source-files:   cabal-version:       >=1.10 +source-repository head+        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   -- other-modules:          -- other-extensions:       build-depends:       base >=4.6 && <5                      , hspec >= 2                      , hspec-core >= 2+                     , hspec-expectations                      , transformers                      , process                      , temporary@@ -40,5 +49,7 @@      build-depends: base                  , hspec+                 , hspec-contrib                  , hspec-server+                 , transformers     Default-Language:   Haskell2010

@@ -1,16 +1,25 @@-import Test.Hspec+import Test.Hspec hiding (it,describe) import Test.Hspec.Server+import Test.Hspec.Contrib.Retry+import Control.Monad.IO.Class  main :: IO () main = hspec $ do   serverSpec localhost $ do-    sdescribe "hoge" $ do-      sit "package test" $ do+    describe "hoge" $ do+      it "package test" $ do+        dat <- getServerData+        os <- liftIO $ detectOS dat+        liftIO $ os `shouldBe` (Just $ Ubuntu "14.04")+      it "package test" $ do         package "zookeeper" `includes` Installed-      sit "port test" $ do+      it "port test" $ do         port 2181 `includes` Listening-      sit "service test" $ do+      it "service test" $ do         service "cron" `includes` Running         service "atd" `includes` Running-      sit "command test" $ do+      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