packages feed

angel 0.6.0 → 0.6.1

raw patch · 11 files changed

+375/−1 lines, 11 filesdep ~base

Dependency ranges changed: base

Files

angel.cabal view
@@ -1,5 +1,5 @@ Name:                angel-Version:             0.6.0+Version:             0.6.1 License:             BSD3 License-file:        LICENSE Author:              Jamie Turner@@ -22,6 +22,8 @@  Extra-source-files:  README.md                      changelog.md+                     test/test_jobs/CompliantJob.hs+                     test/test_jobs/StubbornJob.hs  Cabal-version:       >=1.8 @@ -66,6 +68,12 @@   Type:           exitcode-stdio-1.0   Main-Is:        Spec.hs   Hs-Source-Dirs: src, test+  Other-modules: Angel.ConfigSpec+                 Angel.JobSpec+                 Angel.LogSpec+                 Angel.PidFileSpec+                 Angel.UtilSpec+                 SpecHelper   Build-Depends:  base   Build-Depends:  hspec   Build-depends: base >= 4.0 && < 5
changelog.md view
@@ -1,3 +1,6 @@+0.6.1+* Fix build for GHC 7.10 by adding FlexibleContexts+ 0.6.0 * Upgrade to time 1.5
src/Angel/Job.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE FlexibleContexts #-} module Angel.Job ( syncSupervisors                  , killProcess -- for testing                  , pollStale ) where
+ test/Angel/ConfigSpec.hs view
@@ -0,0 +1,144 @@+{-# LANGUAGE OverloadedStrings #-}+module Angel.ConfigSpec (spec) where++import Angel.Data hiding (spec, Spec)+import Angel.Config++import Control.Exception.Base+import Data.Configurator.Types (Value(..))+import qualified Data.HashMap.Lazy as HM++import SpecHelper++spec :: Spec+spec = do+  describe "modifyProg" $ do+    it "modifies exec" $+      modifyProg prog "exec" (String "foo") `shouldBe`+      prog { exec = Just "foo"}++    it "errors for non-string execs" $+      evaluate (modifyProg prog "exec" (Bool True)) `shouldThrow`+      anyErrorCall++    it "modifies delay for positive numbers" $+      modifyProg prog "delay" (Number 1) `shouldBe`+      prog { delay = Just 1}+    it "modifies delay for 0" $+      modifyProg prog "delay" (Number 0) `shouldBe`+      prog { delay = Just 0}+    it "errors on negative delays" $+      evaluate (modifyProg prog "delay" (Number (-1))) `shouldThrow`+      anyErrorCall++    it "modifies stdout" $+      modifyProg prog "stdout" (String "foo") `shouldBe`+      prog { stdout = Just "foo"}+    it "errors for non-string stdout" $+      evaluate (modifyProg prog "stdout" (Bool True)) `shouldThrow`+      anyErrorCall++    it "modifies stderr" $+      modifyProg prog "stderr" (String "foo") `shouldBe`+      prog { stderr = Just "foo"}+    it "errors for non-string stderr" $+      evaluate (modifyProg prog "stderr" (Bool True)) `shouldThrow`+      anyErrorCall++    it "modifies directory" $+      modifyProg prog "directory" (String "foo") `shouldBe`+      prog { workingDir = Just "foo"}+    it "errors for non-string directory" $+      evaluate (modifyProg prog "directory" (Bool True)) `shouldThrow`+      anyErrorCall++    it "modifies pidfile" $+      modifyProg prog "pidfile" (String "foo.pid") `shouldBe`+      prog { pidFile = Just "foo.pid"}+    it "errors for non-string path" $+      evaluate (modifyProg prog "pidfile" (Bool True)) `shouldThrow`+      anyErrorCall++    it "appends env to the empty list" $+      modifyProg prog "env.foo" (String "bar") `shouldBe`+      prog { env = [("foo", "bar")]}+    it "errors for non-string value" $+      evaluate (modifyProg prog "env.foo" (Bool True)) `shouldThrow`+      anyErrorCall+    it "prepends env to an existing list" $+      modifyProg prog { env = [("previous", "value")]} "env.foo" (String "bar") `shouldBe`+      prog { env = [("foo", "bar"), ("previous", "value")]}++    it "interprets boolean False as Nothing" $+      modifyProg prog "termgrace" (Bool False) `shouldBe`+      prog { termGrace = Nothing }+    it "interprets 0 as Nothing" $+      modifyProg prog "termgrace" (Number 0) `shouldBe`+      prog { termGrace = Nothing }+    it "interprets > 0 as a set termGrace" $+      modifyProg prog "termgrace" (Number 2) `shouldBe`+      prog { termGrace = Just 2 }+    it "interprets boolean True as an error" $+      evaluate (modifyProg prog "termgrace" (Bool True)) `shouldThrow`+      anyErrorCall+    it "interprets negative numbers as an error" $+      evaluate (modifyProg prog "termgrace" (Number (-1))) `shouldThrow`+      anyErrorCall+    it "interprets anything else as an error" $+      evaluate (modifyProg prog "termgrace" (String "yeah")) `shouldThrow`+      anyErrorCall++    it "does nothing for all other cases" $+      modifyProg prog "bogus" (String "foo") `shouldBe`+      prog++  describe "expandByCount" $ do+    it "doesn't affect empty hashes" $+      expandByCount HM.empty `shouldBe`+        HM.empty+    it "doesn't affect hashes without counts" $+      expandByCount (HM.fromList [baseProgPair]) `shouldBe`+        HM.fromList [baseProgPair]+    it "errors on mistyped count field" $+      evaluate (expandByCount (HM.fromList [baseProgPair+                                           , ("prog.count", String "wat")])) `shouldThrow`+        anyErrorCall+    it "errors on negative count field" $+      evaluate (expandByCount (HM.fromList [ baseProgPair+                                           , ("prog.count", Number (-1))])) `shouldThrow`+        anyErrorCall+    it "generates no configs with a count of 0" $+      expandByCount (HM.fromList [ baseProgPair+                                 , ("prog.count", Number 0)]) `shouldBe`+        HM.empty+    it "expands with a count of 1" $+      expandByCount (HM.fromList [baseProgPair, ("prog.count", Number 1)]) `shouldBe`+        HM.fromList [ ("prog-1.exec", String "foo")+                    , ("prog-1.env.ANGEL_PROCESS_NUMBER", String "1")]+    it "expands with a count of > 1" $+      expandByCount (HM.fromList [baseProgPair, ("prog.count", Number 2)]) `shouldBe`+        HM.fromList [ ("prog-1.exec", String "foo")+                    , ("prog-1.env.ANGEL_PROCESS_NUMBER", String "1")+                    , ("prog-2.exec", String "foo")+                    , ("prog-2.env.ANGEL_PROCESS_NUMBER", String "2")]+    it "preserves explicit env variables" $+      expandByCount (HM.fromList [baseProgPair, ("prog.env.FOO", String "bar")]) `shouldBe`+        HM.fromList [ ("prog.exec",    String "foo")+                    , ("prog.env.FOO", String "bar")]+    it "expands pidfiles with a count of 1" $+      expandByCount (HM.fromList [ baseProgPair+                                 , ("prog.count", Number 1)+                                 , ("prog.pidfile", String "foo.pid")]) `shouldBe`+        HM.fromList [ ("prog-1.exec", String "foo")+                    , ("prog-1.env.ANGEL_PROCESS_NUMBER", String "1")+                    , ("prog-1.pidfile", String "foo-1.pid")] --TODO: try without expanding if count == 1+  describe "processConfig internal API" $+    it "can parse the example config" $+      shouldReturnRight $ processConfig "example.conf"+  where prog = defaultProgram+        baseProgPair = ("prog.exec", String "foo")+        shouldReturnRight a = flip shouldSatisfy isRight =<< a++isRight :: Either a b -> Bool+isRight (Right _) = True+isRight _         = False
+ test/Angel/JobSpec.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE CPP #-}+module Angel.JobSpec (spec) where++import Angel.Job (killProcess)+import Angel.Process ( getProcessHandleStatus+                     , hardKillProcessHandle )+import Angel.Data hiding (Spec, spec)+import Angel.Util (sleepSecs)++import Control.Monad.IO.Class+import System.Exit (ExitCode(..))+import System.Posix.Directory (getWorkingDirectory)+import System.Posix.Signals (sigKILL)+import System.Posix.Process (ProcessStatus(..))+import System.Process ( createProcess+                      , proc+                      , ProcessHandle )++import SpecHelper++spec :: Spec+spec =+  describe "killProcess" $ do+    describe "using SoftKill" $ do+      it "cleanly kills well-behaved processes" $ runAngelM dummyOptions $ do+        ph <- liftIO launchCompliantJob+        killProcess $ SoftKill "thing" ph Nothing+        liftIO $+          patientlyGetProcessExitCode ph `shouldReturn` (Just $ Exited ExitSuccess)++      it "does not forcefully kill stubborn processes" $ runAngelM dummyOptions $ do+        ph <- liftIO launchStubbornJob+        killProcess $ SoftKill "thing" ph Nothing+        -- stubborn job gets marked as [defunct] here. no idea why. it should be able to survive a SIGTERM+        liftIO $ do+          patientlyGetProcessExitCode ph `shouldReturn` Nothing+          hardKillProcessHandle ph -- cleanup++    describe "using HardKill" $ do+      it "cleanly kills well-behaved processes" $ runAngelM dummyOptions $ do+        ph <- liftIO launchCompliantJob+        killProcess $ HardKill "thing" ph Nothing 1+        -- Can't geth the exiit status because the life check in Job "uses up" the waitpid+        liftIO $+          patientlyGetProcessExitCode ph `shouldReturn` Nothing+      it "forcefully kills stubborn processes" $ runAngelM dummyOptions $ do+        ph <- liftIO launchStubbornJob+        killProcess $ HardKill "thing" ph Nothing 1+        liftIO $+#if MIN_VERSION_unix(2,7,0)+          patientlyGetProcessExitCode ph `shouldReturn` (Just $ Terminated sigKILL False)+#else+          patientlyGetProcessExitCode ph `shouldReturn` (Just $ Terminated sigKILL)+#endif+    describe "with a logger" $+      it "cleanly kills well-behaved loggers" $ runAngelM dummyOptions $ do+        ph <- liftIO launchCompliantJob+        lph <- liftIO launchCompliantJob+        killProcess $ SoftKill "thing" ph (Just lph)+        liftIO $+          patientlyGetProcessExitCode lph `shouldReturn` (Just $ Exited ExitSuccess)++launchCompliantJob :: IO ProcessHandle+launchCompliantJob = launchJob "CompliantJob"++launchStubbornJob :: IO ProcessHandle+launchStubbornJob = launchJob "StubbornJob"++launchJob :: FilePath -> IO ProcessHandle+launchJob n = do wd <- getWorkingDirectory+                 let path = wd ++ "/test/test_jobs/" ++ n+                 (_, _, _, ph) <- createProcess $ proc path []+                 sleepSecs 1+                 return ph++patientlyGetProcessExitCode :: ProcessHandle -> IO (Maybe ProcessStatus)+patientlyGetProcessExitCode ph = sleepSecs 1 >> getProcessHandleStatus ph++dummyOptions :: Options+dummyOptions = Options {+      configFile = ""+    , verbosity  = V0+    }
+ test/Angel/LogSpec.hs view
@@ -0,0 +1,24 @@+module Angel.LogSpec (spec) where++import Angel.Log++import Data.Time+import Data.Time.Calendar (fromGregorian)+import Data.Time.LocalTime (timeOfDayToTime,+                            TimeOfDay(..),+                            TimeZone(..),+                            ZonedTime(..))++import SpecHelper+++spec :: Spec+spec = do+  describe "cleanCalendar" $ do+    it "formats the time correctly" $ cleanCalendar dateTime `shouldBe` "2012/09/12 03:14:59"+  --where time = CalendarTime 2012 September 12 3 14 59 0 Tuesday 263 "Pacific" -25200 True+  where dateTime  = ZonedTime localTime zone+        localTime = LocalTime day tod+        day       = fromGregorian 2012 9 12+        tod       = TimeOfDay 3 14 59+        zone      = TimeZone (-420) False "PDT"
+ test/Angel/PidFileSpec.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE ScopedTypeVariables #-}+module Angel.PidFileSpec (spec) where++import Angel.PidFile++import Control.Exception.Base ( try+                              , SomeException )+import Data.Char (isNumber)+import Data.IORef ( newIORef+                  , readIORef+                  , writeIORef )+import System.Process (proc)+import System.Posix.Files (fileExist)++import SpecHelper++spec :: Spec+spec =+  describe "startWithPidFile" $ do+    it "creates the pidfile and cleans up" $ do+      startWithPidFile procSpec fileName jogOn $ \_pHandle -> do+        fileShouldExist fileName+        pid <- readFile fileName+        null pid `shouldBe` False+        all isNumber pid `shouldBe` True+      fileShouldNotExist fileName+    it "calls the error callback when pidfile can't be created and re-raises" $ do+      called <- newIORef False+      let onPidError = const $ writeIORef called True+      (res :: Either SomeException ()) <- try $ startWithPidFile procSpec badPidFile jogOn onPidError+      readIORef called `shouldReturn` True+      isLeft res `shouldBe` True+  where+    fileName = "temp.pid"+    badPidFile = "/bogus/path/to/pidfile"+    procSpec = proc "pwd" []+    fileShouldExist _name    = fileExist fileName `shouldReturn` True+    fileShouldNotExist _name = fileExist fileName `shouldReturn` False+    jogOn = const $ return ()+    isLeft (Left _) = True+    isLeft _        = False
+ test/Angel/UtilSpec.hs view
@@ -0,0 +1,34 @@+module Angel.UtilSpec (spec) where++import Angel.Util++import System.Posix.User (getEffectiveUserID,+                          getUserEntryForID,+                          UserEntry(..))++import SpecHelper++spec :: Spec+spec = do+  describe "expandPath" $ do+    it "generates the correct path for just a tilde" $ do+      UserEntry { homeDirectory = home } <- getUserEntry+      path <- expandPath "~/foo"+      path `shouldBe` home ++ "/foo"+    it "generates the correct path for tilde with a specific user" $ do+      UserEntry { homeDirectory = home,+                  userName      = user } <- getUserEntry+      path <- expandPath $ "~" ++ user ++ "/foo"+      path `shouldBe` home ++ "/foo"+    it "leaves paths without tildes alone" $ do+      path <- expandPath "/foo"+      path `shouldBe` "/foo"+  describe "split" $ do+    prop "produces no null values" $ \(a :: Char) (xs :: [Char]) ->+      none null $ split a xs+    prop "produces no instances of the split element" $ \(a :: Char) (xs :: [Char]) ->+      none (elem a) $ split a xs+    it "splits" $+      split ' ' "  foo  bar     baz  " `shouldBe` ["foo", "bar", "baz"]+  where getUserEntry = getUserEntryForID =<< getEffectiveUserID+        none p = not . any p
+ test/SpecHelper.hs view
@@ -0,0 +1,4 @@+module SpecHelper (module X) where++import Test.Hspec as X+import Test.Hspec.QuickCheck as X
+ test/test_jobs/CompliantJob.hs view
@@ -0,0 +1,15 @@+module Main (main) where++import GHC.IO.Handle+import System.IO (stdout)+import Control.Concurrent.MVar (newEmptyMVar, putMVar, takeMVar)+import System.Exit (exitWith, ExitCode(ExitSuccess))+import System.Posix.Signals (installHandler, sigTERM, Handler(Catch))++main :: IO ()+main = do+  hSetBuffering stdout NoBuffering+  putStrLn "Compliant job started"+  sig <- newEmptyMVar+  installHandler sigTERM (Catch $ print "term" >> putMVar sig ExitSuccess) Nothing+  exitWith =<< takeMVar sig
+ test/test_jobs/StubbornJob.hs view
@@ -0,0 +1,17 @@+module Main (main) where++import GHC.IO.Handle+import System.IO (stdout)+import Control.Concurrent (threadDelay, forkIO)+import Control.Concurrent.MVar (newEmptyMVar, takeMVar, putMVar)+import System.Posix.Signals (installHandler, sigTERM, Handler(Catch))++main :: IO ()+main = do+  hSetBuffering stdout NoBuffering+  putStrLn "Stubborn job started"+  sig <- newEmptyMVar+  installHandler sigTERM (Catch $ print "term, ignoring" >> return ()) Nothing+  forkIO $ threadDelay maxBound >> putMVar sig ()+  () <- takeMVar sig+  return ()