module Puppet.Testing
( module Control.Lens
, module Data.Monoid
, module Puppet.PP
, module Puppet.Interpreter.Types
, module Puppet.Lens
, H.hspec
, basicTest
, usersGroupsDefined
, testingDaemon
, defaultDaemon
, testCatalog
, describeCatalog
, it
, shouldBe
, PSpec
, PSpecM
, lCatalog
, lModuledir
, lPuppetdir
, withResource
, withParameter
, withParameters
, withFileContent
) where
import Prelude hiding (notElem,all)
import Control.Lens
import Data.Foldable hiding (forM_,mapM_)
import Data.Maybe
import Data.Monoid
import Control.Monad.Error
import Control.Monad.Reader
import Control.Applicative
import System.Posix.Files
import qualified Data.HashSet as HS
import qualified Data.Either.Strict as S
import qualified Data.Text as T
import qualified System.Log.Logger as LOG
import qualified Test.Hspec as H
import qualified Test.Hspec.Formatters as H
import qualified Test.Hspec.Runner as H
import qualified Test.Hspec.Core as HC
import Facter
import PuppetDB.Common
import Puppet.Preferences
import Puppet.PP hiding ((<$>))
import Puppet.Daemon
import Puppet.Lens
import Puppet.Interpreter.Types
import Puppet.Interpreter.PrettyPrinter ()
data TestEnv = TestEnv { _lCatalog :: FinalCatalog
, _lModuledir :: FilePath
, _lPuppetdir :: FilePath
}
makeClassy ''TestEnv
type PSpecM = ReaderT TestEnv HC.SpecM
type PSpec = PSpecM ()
testCatalog :: Nodename -> FilePath -> FinalCatalog -> PSpec -> IO H.Summary
testCatalog nd pdir catlg test = H.hspecWith (H.defaultConfig { H.configFormatter = H.silent { H.failedFormatter = fform } })
(describeCatalog nd pdir catlg test)
where
fform = do
failures <- H.getFailMessages
forM_ failures $ \(H.FailureRecord path reason) -> do
H.write ("[" ++ T.unpack nd ++ "] ")
H.writeLine (snd path)
let err = either (("uncaught exception: " ++) . H.formatException) id reason
H.withFailColor $ unless (null err) $ H.writeLine err
unless (null failures) H.newParagraph
describeCatalog :: Nodename -> FilePath -> FinalCatalog -> PSpec -> H.Spec
describeCatalog nd pdir catlg test = H.describe (T.unpack nd) $ runReaderT test (TestEnv catlg (pdir <> "/modules") pdir)
basicTest :: PSpec
basicTest = hTestFileSources
usersGroupsDefined :: PSpec
usersGroupsDefined = do
c <- view lCatalog
let getResourceType t = c ^.. traverse . filtered (\r -> r ^. rid . itype == t && r ^. rattributes . at "ensure" /= Just "absent")
users = getResourceType "user"
groups = getResourceType "group"
knownUsers = HS.fromList $ map (view (rid . iname)) users ++ ["root","","syslog","mysql","puppet","vagrant","nginx","www-data","nagios", "postgres"]
knownGroups = HS.fromList $ map (view (rid . iname)) groups ++ ["root", "adm", "syslog", "mysql", "nagios","puppet","","www-data", "postgres"]
checkResource lensU lensG = mapM_ (checkResource' lensU lensG)
checkResource' lensU lensG res = do
let d = "Resource " <> show (pretty res) <> " should have a valid "
case lensU of
Just lensU' -> do
let u = res ^. rattributes . lensU' . _PString
H.it (d <> "username (" ++ T.unpack u ++ ")") (HS.member u knownUsers)
Nothing -> return ()
case lensG of
Just lensG' -> do
let g = res ^. rattributes . lensG' . _PString
H.it (d <> "group (" ++ T.unpack g ++ ")") (HS.member g knownGroups)
Nothing -> return ()
lift $ do
checkResource (Just $ ix "owner") (Just $ ix "group") (getResourceType "file")
checkResource (Just $ ix "user") (Just $ ix "group") (getResourceType "exec")
checkResource (Just $ ix "user") Nothing (getResourceType "cron")
checkResource (Just $ ix "user") Nothing (getResourceType "ssh_authorized_key")
checkResource (Just $ ix "user") Nothing (getResourceType "ssh_authorized_key_secure")
checkResource (Nothing) (Just $ ix "gid") users
it :: HC.Example a => String -> PSpecM a -> PSpec
it n tst = tst >>= lift . H.it n
shouldBe :: (Show a, Eq a) => a -> a -> PSpecM H.Expectation
shouldBe a b = return (a `H.shouldBe` b)
withResource :: String
-> T.Text
-> T.Text
-> (Resource -> H.Expectation)
-> PSpec
withResource desc t n o = do
let ridentifier = RIdentifier t n
mr <- view (lCatalog . at ridentifier)
lift $ case mr of
Nothing -> H.it ("Should have resource " ++ show (pretty ridentifier)) (H.expectationFailure "Resource not found")
Just v -> H.it ("Resource " ++ show (pretty ridentifier) ++ " should " ++ desc) (o v)
withParameter :: T.Text
-> Resource
-> (PValue -> H.Expectation)
-> H.Expectation
withParameter prm r o = do
case r ^. rattributes . at prm of
Nothing -> H.expectationFailure ("Parameter " ++ T.unpack prm ++ " not found")
Just v -> o v
withParameters :: [(T.Text, PValue)]
-> Resource
-> H.Expectation
withParameters prmlist r = forM_ prmlist $ \(nm, vl) -> withParameter nm r (`H.shouldBe` vl)
withFileContent :: String
-> T.Text
-> (T.Text -> H.Expectation)
-> PSpec
withFileContent desc fn action = withResource desc "file" fn $ \r ->
case r ^? rattributes . ix "content" . _PString of
Just v -> action v
Nothing -> H.expectationFailure "Content not found"
hTestFileSources :: PSpec
hTestFileSources = do
let getFiles = filter presentFile . toList
presentFile r | r ^. rid . itype /= "file" = False
| (r ^. rattributes . at "ensure") `notElem` [Nothing, Just "present"] = False
| r ^. rattributes . at "source" == Just PUndef = False
| otherwise = True
getSource = mapMaybe (\r -> (,) `fmap` pure r <*> r ^. rattributes . at "source")
files <- fmap (getSource . getFiles) $ view lCatalog
pdir <- view lPuppetdir
forM_ files $ \(r,filesource) -> it ("should have a source for " ++ r ^. rid . iname . to T.unpack) $ do
let
testFile :: FilePath -> ErrorT PrettyError IO ()
testFile fp = liftIO (fileExist fp) >>= (`unless` (throwError $ PrettyError $ "Searched in" <+> string fp))
checkFile :: PValue -> ErrorT PrettyError IO ()
checkFile res@(PArray ar) = asum [checkFile x | x <- toList ar] <|> throwError (PrettyError $ "Could not find the file in" <+> pretty res)
checkFile (PString f) =
case (T.stripPrefix "puppet:///" f, T.stripPrefix "file:///" f) of
(Just stringdir, _) -> case T.splitOn "/" stringdir of
("modules":modulename:rest) -> testFile (pdir <> "/modules/" <> T.unpack modulename <> "/files/" <> T.unpack (T.intercalate "/" rest))
("files":rest) -> testFile (pdir <> "/files/" <> T.unpack (T.intercalate "/" rest))
("private":_) -> return ()
_ -> throwError (PrettyError $ "Invalid file source:" <+> ttext f)
(Nothing, Just _) -> return ()
_ -> throwError (PrettyError $ "The source does not start with puppet:///, but is" <+> ttext f)
checkFile x = throwError (PrettyError $ "Source was not a string, but" <+> pretty x)
return $ do
rs <- runErrorT (checkFile filesource)
case rs of
Right () -> return ()
Left rr -> fail (show (getError rr))
testingDaemon :: PuppetDBAPI IO
-> FilePath
-> (T.Text -> IO Facts)
-> IO (T.Text -> IO (S.Either PrettyError (FinalCatalog, EdgeMap, FinalCatalog, [Resource])))
testingDaemon pdb pdir allFacts = do
LOG.updateGlobalLogger "Puppet.Daemon" (LOG.setLevel LOG.WARNING)
prefs <- setupPreferences pdir (prefPDB.~pdb)
q <- initDaemon prefs
return (\nodname -> allFacts nodname >>= _dGetCatalog q nodname)
defaultDaemon :: FilePath -> IO (T.Text -> IO (S.Either PrettyError (FinalCatalog, EdgeMap, FinalCatalog, [Resource])))
defaultDaemon pdir = do
pdb <- getDefaultDB PDBTest >>= \case
S.Left x -> error (show (getError x))
S.Right y -> return y
testingDaemon pdb pdir (flip puppetDBFacts pdb)