content: -- | The module accumulates 'PrettyError's in the ExceptT monad transformer.
  module Puppet.Runner.Daemon.OptionalTests (testCatalog) where
  
  import qualified Data.HashSet as Set
  import qualified Data.Text as Text
  import Puppet.Language
  import Puppet.Runner.Preferences
  import qualified System.Directory as Directory
  import XPrelude
  
  -- | Entry point for all optional tests
  testCatalog ::
    Preferences IO ->
    FinalCatalog ->
    IO (Either PrettyError ())
  testCatalog prefs c =
    runExceptT $
      testFileSources (prefs ^. prefPuppetPaths . baseDir) c
        *> testUsersGroups (prefs ^. prefKnownusers) (prefs ^. prefKnowngroups) c
  
  -- | Tests that all users and groups are defined
  testUsersGroups :: [Text] -> [Text] -> FinalCatalog -> ExceptT PrettyError IO ()
  testUsersGroups kusers kgroups c = do
    let users = Set.fromList $ "" : "0" : map (view (rid . iname)) (getResourceFrom "user") ++ kusers
        groups = Set.fromList $ "" : "0" : map (view (rid . iname)) (getResourceFrom "group") ++ kgroups
        checkResource lu lg = mapM_ (checkResource' lu lg)
        checkResource' lu lg res = do
          let msg att name =
                align
                  ( vsep
                      [ "Resource"
                          <+> ppline (res ^. rid . itype)
                          <+> ppline (res ^. rid . iname)
                          <+> showPos (res ^. rpos . _1),
                        "references the unknown" <+> att <+> squotes (ppline name)
                      ]
                  )
                  <> line
          case lu of
            Just lu' -> do
              let u = res ^. rattributes . lu' . _PString
              unless (Set.member u users) $ throwE $ PrettyError (msg "user" u)
            Nothing -> pure ()
          case lg of
            Just lg' -> do
              let g = res ^. rattributes . lg' . _PString
              unless (Set.member g groups) $ throwE $ PrettyError (msg "group" g)
            Nothing -> pure ()
    do
      checkResource (Just $ ix "owner") (Just $ ix "group") (getResourceFrom "file")
      checkResource (Just $ ix "user") (Just $ ix "group") (getResourceFrom "exec")
      checkResource (Just $ ix "user") Nothing (getResourceFrom "cron")
      checkResource (Just $ ix "user") Nothing (getResourceFrom "ssh_authorized_key")
      checkResource (Just $ ix "user") Nothing (getResourceFrom "ssh_authorized_key_secure")
      checkResource Nothing (Just $ ix "gid") (getResourceFrom "users")
    where
      getResourceFrom t = c ^.. traverse . filtered (\r -> r ^. rid . itype == t && r ^. rattributes . at "ensure" /= Just "absent")
  
  -- | Test source for every file resources in the catalog.
  testFileSources :: FilePath -> FinalCatalog -> ExceptT PrettyError IO ()
  testFileSources basedir c = do
    let getfiles = filter presentFile . toList
        presentFile r =
          r ^. rid . itype == "file"
            && (r ^. rattributes . at "ensure") `elem` [Nothing, Just "present"]
            && r ^. rattributes . at "source" /= Just PUndef
        recurse r = case r ^? rattributes . ix "recurse" of
          Just (PString "true") -> True
          Just (PBoolean b) -> b
          _ -> False
        getsource = mapMaybe (\r -> (,,) r <$> r ^. rattributes . at "source" <*> pure (recurse r))
    checkAllSources basedir $ (getsource . getfiles) c
  
  -- | Check source for all file resources and append failures along.
  checkAllSources :: FilePath -> [(Resource, PValue, Bool)] -> ExceptT PrettyError IO ()
  checkAllSources fp fs =
    -- we could just do :
    -- traverse_ (\(res, src) -> catchE (checkFile fp src) (throwE ...)) fs
    -- but that would print the first encountered failure.
    go fs []
    where
      go :: [(Resource, PValue, Bool)] -> [PrettyError] -> ExceptT PrettyError IO ()
      go ((res, filesrc, recurse) : xs) es = ExceptT $ do
        runExceptT (checkFile fp filesrc recurse) >>= \case
          Right () -> runExceptT $ go xs es
          Left err ->
            runExceptT $
              go
                xs
                ( PrettyError
                    ( align
                        ( vsep
                            [ "Could not find" <+> pretty filesrc,
                              getError err,
                              showPos (res ^. (rpos . _1))
                            ]
                        )
                    )
                    : es
                )
      go [] [] = pure ()
      go [] es = throwE (mconcat es)
  
  testFile :: Bool -> FilePath -> ExceptT PrettyError IO ()
  testFile recurse fp = do
    p <- liftIO (Directory.doesFileExist fp)
    p' <-
      if recurse && not p
        then liftIO (Directory.doesDirectoryExist fp)
        else return p
    unless p' (throwE $ PrettyError $ "searched in" <+> squotes (pptext fp))
  
  -- | Only test the `puppet:///` protocol (files managed by the puppet server)
  --   we don't test absolute path (puppet client files)
  checkFile :: FilePath -> PValue -> Bool -> ExceptT PrettyError IO ()
  checkFile basedir (PString f) recurse =
    case Text.stripPrefix "puppet:///" f of
      Just stringdir -> case Text.splitOn "/" stringdir of
        ("modules" : modname : rest) -> testFile recurse (basedir <> "/modules/" <> toS modname <> "/files/" <> toS (Text.intercalate "/" rest))
        ("files" : rest) -> testFile recurse (basedir <> "/files/" <> toS (Text.intercalate "/" rest))
        ("private" : _) -> pure ()
        _ -> throwE (PrettyError $ "Invalid file source:" <+> ppline f)
      Nothing -> return ()
  -- source is always an array of possible paths. We only fails if none of them check.
  checkFile basedir (PArray xs) recurse = asum [checkFile basedir x recurse | x <- toList xs]
  checkFile _ x _ = throwE (PrettyError $ "Source was not a string, but" <+> pretty x)
  