packages feed

hspec-server (empty) → 0.1.0.0

raw patch · 5 files changed

+307/−0 lines, 5 filesdep +HUnitdep +basedep +containerssetup-changed

Dependencies added: HUnit, base, containers, hspec, hspec-core, hspec-server, process, regex-posix, temporary, transformers

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2014, Junji Hashimoto++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Junji Hashimoto nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Test/Hspec/Server.hs view
@@ -0,0 +1,215 @@+{-# 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++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
+ hspec-server.cabal view
@@ -0,0 +1,44 @@+-- Initial hspec-server.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                hspec-server+version:             0.1.0.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.+license:             BSD3+license-file:        LICENSE+author:              Junji Hashimoto+maintainer:          junji.hashimoto@gmail.com+stability:           Experimental+category:            Testing+build-type:          Simple+-- extra-source-files:  +cabal-version:       >=1.10++library+  exposed-modules:     Test.Hspec.Server+  -- other-modules:       +  -- other-extensions:    +  build-depends:       base >=4.6 && <5+                     , hspec >= 2+                     , hspec-core >= 2+                     , transformers+                     , process+                     , temporary+                     , containers+                     , HUnit+                     , regex-posix+  -- hs-source-dirs:      +  default-language:    Haskell2010++test-suite test+    type:              exitcode-stdio-1.0+    main-is:           test.hs+    hs-source-dirs:    test,dist/build/autogen+    ghc-options:       -Wall++    build-depends: base+                 , hspec+                 , hspec-server+    Default-Language:   Haskell2010
+ test/test.hs view
@@ -0,0 +1,16 @@+import Test.Hspec+import Test.Hspec.Server++main :: IO ()+main = hspec $ do+  serverSpec localhost $ do+    sdescribe "hoge" $ do+      sit "package test" $ do+        package "zookeeper" `includes` Installed+      sit "port test" $ do+        port 2181 `includes` Listening+      sit "service test" $ do+        service "cron" `includes` Running+        service "atd" `includes` Running+      sit "command test" $ do+        command "ls" [] [] `includes` Exit 0