module Puppet.Language.NativeTypes.Host (nativeHost) where
import qualified Data.Char as Char
import qualified Data.Text as Text
import Puppet.Language.NativeTypes.Helpers
nativeHost :: (NativeTypeName, NativeTypeMethods)
nativeHost = ("host", nativetypemethods parameterfunctions return)
parameterfunctions :: [(Text, [Text -> NativeTypeValidate])]
parameterfunctions =
[("comment" , [string, values ["true","false"]])
,("ensure" , [defaultvalue "present", string, values ["present","absent"]])
,("host_aliases" , [rarray, strings, checkhostname])
,("ip" , [string, mandatory, ipaddr])
,("name" , [nameval, checkhostname])
,("provider" , [string, values ["parsed"]])
,("target" , [string, fullyQualified])
]
checkhostname :: Text -> NativeTypeValidate
checkhostname param res = case res ^. rattributes . at param of
Nothing -> Right res
Just (PArray xs) -> foldM (checkhostname' param) res xs
Just x@(PString _) -> checkhostname' param res x
Just x -> perror $ paramname param <+> "should be an array or a single string, not" <+> pretty x
checkhostname' :: Text -> Resource -> PValue -> Either PrettyError Resource
checkhostname' prm _ (PString "") = perror $ "Empty hostname for parameter" <+> paramname prm
checkhostname' prm res (PString x ) = checkhostname'' prm res x
checkhostname' prm _ x = perror $ "Parameter " <+> paramname prm <+> "should be an string or an array of strings, but this was found :" <+> pretty x
checkhostname'' :: Text -> Resource -> Text -> Either PrettyError Resource
checkhostname'' prm _ "" = perror $ "Empty hostname part in parameter" <+> paramname prm
checkhostname'' prm res prt =
let (cur,nxt) = Text.break (=='.') prt
nextfunc = if Text.null nxt
then Right res
else checkhostname'' prm res (Text.tail nxt)
in if Text.null cur || (Text.head cur == '-') || not (Text.all (\x -> Char.isAlphaNum x || (x=='-')) cur)
then perror $ "Invalid hostname part for parameter" <+> paramname prm
else nextfunc