module Puppet.Testing
( module Control.Lens
, module Data.Monoid
, module Puppet.PP
, module Puppet.Interpreter.Types
, H.hspec
, basicTest
, testingDaemon
, defaultDaemon
, testCatalog
, describeCatalog
, it
, shouldBe
) where
import Prelude hiding (notElem,all)
import Control.Lens
import Data.Foldable hiding (forM_)
import Data.Maybe
import Data.Monoid
import Control.Monad.Error
import Control.Monad.Reader
import Control.Applicative hiding ((<$>))
import System.Posix.Files
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
import Puppet.Daemon
import Puppet.Interpreter.Types
import Puppet.Interpreter.PrettyPrinter ()
data TestEnv = TestEnv { _catalog :: FinalCatalog
, _moduledir :: FilePath
, _puppetdir :: 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
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)
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 catalog
pdir <- view puppetdir
forM_ files $ \(r,filesource) -> it ("should have a source for " ++ r ^. rid . iname . to T.unpack) $ do
let
testFile :: FilePath -> ErrorT Doc IO ()
testFile fp = liftIO (fileExist fp) >>= (`unless` (throwError $ "Searched in" <+> string fp))
checkFile :: PValue -> ErrorT Doc IO ()
checkFile res@(PArray ar) = asum [checkFile x | x <- toList ar] <|> throwError ("Could not find the file in" <+> pretty res)
checkFile (PString f) = do
stringdir <- case T.stripPrefix "puppet:///" f of
Just o -> return o
Nothing -> throwError ("The source does not start with puppet:///, but is" <+> ttext f)
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 ("Invalid file source:" <+> ttext f)
checkFile x = throwError ("Source was not a string, but" <+> pretty x)
return $ do
rs <- runErrorT (checkFile filesource)
case rs of
Right () -> return ()
Left rr -> fail (show rr)
testingDaemon :: PuppetDBAPI
-> FilePath
-> (T.Text -> IO (Container T.Text))
-> IO (T.Text -> IO (S.Either Doc (FinalCatalog, EdgeMap, FinalCatalog)))
testingDaemon pdb pdir allFacts = do
LOG.updateGlobalLogger "Puppet.Daemon" (LOG.setLevel LOG.WARNING)
prefs <- genPreferences pdir
q <- initDaemon (prefs { _prefPDB = pdb })
return (\nodname -> allFacts nodname >>= _dGetCatalog q nodname)
defaultDaemon :: FilePath -> IO (T.Text -> IO (S.Either Doc (FinalCatalog, EdgeMap, FinalCatalog)))
defaultDaemon pdir = do
pdb <- getDefaultDB PDBTest >>= \case
S.Left x -> error (show x)
S.Right y -> return y
testingDaemon pdb pdir (flip puppetDBFacts pdb)