module Puppet.Language.NativeTypes.File (nativeFile) where

import qualified Data.Attoparsec.Text                as AT
import qualified Data.Char                           as Char
import qualified Data.Map.Strict                     as Map
import qualified Data.Set                            as Set
import qualified Data.Text                           as Text

import           Puppet.Language.NativeTypes.Helpers


nativeFile :: (NativeTypeName, NativeTypeMethods)
nativeFile = ("file", nativetypemethods parameterfunctions (validateSourceOrContent >=> validateMode))


-- Autorequires: If Puppet is managing the user or group that owns a file, the file resource will autorequire them. If Puppet is managing any parent directories of a file, the file resource will autorequire them.

parameterfunctions :: [(Text, [Text -> NativeTypeValidate])]
parameterfunctions =
    [("backup"               , [string])
    ,("checksum"             , [values ["md5", "md5lite", "mtime", "ctime", "none"]])
    ,("content"              , [string])
    --,("ensure"               , [defaultvalue "present", string, values ["directory","file","present","absent","link"]])
    ,("ensure"               , [defaultvalue "present", string])
    ,("force"                , [string, values ["true","false"]])
    ,("group"                , [defaultvalue "root", string])
    ,("ignore"               , [strings])
    ,("links"                , [string])
    ,("mode"                 , [defaultvalue "0644", string])
    ,("owner"                , [string])
    ,("path"                 , [nameval, fullyQualified, noTrailingSlash'])
    ,("provider"             , [values ["posix","windows"]])
    ,("purge"                , [string, values ["true","false"]])
    ,("recurse"              , [string, values ["inf","true","false","remote"]])
    ,("recurselimit"         , [integer])
    ,("replace"              , [string, values ["true","false","yes","no"]])
    ,("show_diff"            , [string, values ["true","false"]])
    ,("sourceselect"         , [values ["first","all"]])
    ,("seltype"              , [string])
    ,("selrange"             , [string])
    ,("selinux_ignore_defaults", [string, values ["true","false"]])
    ,("selrole"              , [string])
    ,("target"               , [string])
    ,("source"               , [rarray, strings, flip runarray checkSource])
    ,("seluser"              , [string])
    ,("validate_cmd"         , [string])
    ,("validate_replacement" , [string])
    ]

noTrailingSlash' :: Text -> NativeTypeValidate
noTrailingSlash' param res
  | res ^? rattributes . ix "ensure" == Just "directory" = Right res
  | otherwise = noTrailingSlash param res

validateMode :: NativeTypeValidate
validateMode res = do
    modestr <- case res ^. rattributes . at "mode" of
                  Just (PString s) -> return s
                  Just x -> throwError $ PrettyError ("Invalide mode type, should be a string " <+> pretty x)
                  Nothing -> throwError "Could not find mode!"
    (numeric modestr <|> except (ugo modestr)) & runExcept & _Right %~ ($ res)

numeric :: Text -> Except PrettyError (Resource -> Resource)
numeric modestr = do
    when ((Text.length modestr /= 3) && (Text.length modestr /= 4)) (throwError "Invalid mode size")
    unless (Text.all Char.isDigit modestr) (throwError "The mode should only be made of digits")
    return $ if Text.length modestr == 3
                 then rattributes . at "mode" ?~ PString (Text.cons '0' modestr)
                 else identity

checkSource :: Text -> PValue -> NativeTypeValidate
checkSource _ (PString x) res | any (`Text.isPrefixOf` x) ["puppet://", "file://", "/", "http://", "https://"] = Right res
                              | otherwise = throwError "A source should start with either puppet://, http://, https:// or file:// or an absolute path"
checkSource _ x _ = throwError $ PrettyError ("Expected a string, not" <+> pretty x)

data PermParts = Special | User | Group | Other
               deriving (Eq, Ord)

data PermSet = R | W | X
             deriving (Ord, Eq)

ugo :: Text -> Either PrettyError (Resource -> Resource)
ugo t = AT.parseOnly (modestring <* AT.endOfInput) t
        & _Left %~ (\rr -> PrettyError $ "Could not parse the mode string: " <> ppstring rr)
        & _Right %~ (\s -> rattributes . at "mode" ?~ PString (mkmode Special s <> mkmode User s <> mkmode Group s <> mkmode Other s))

mkmode :: PermParts -> Map PermParts (Set PermSet) -> Text
mkmode p m = let s = m ^. at p . non mempty
             in  Text.pack $ show $ fromEnum (Set.member R s) * 4
                               + fromEnum (Set.member W s) * 2
                               + fromEnum (Set.member X s)

modestring :: AT.Parser (Map PermParts (Set.Set PermSet))
modestring = Map.fromList . mconcat <$> (modepart `AT.sepBy` AT.char ',')

-- TODO suid, sticky and other funky things are not yet supported
modepart :: AT.Parser [(PermParts, Set PermSet)]
modepart = do
    let permpart =   (AT.char 'u' *> pure [User])
                 <|> (AT.char 'g' *> pure [Group])
                 <|> (AT.char 'o' *> pure [Other])
                 <|> (AT.char 'a' *> pure [User,Group,Other])
        permission =   (AT.char 'r' *> pure R)
                   <|> (AT.char 'w' *> pure W)
                   <|> (AT.char 'x' *> pure X)
    pp <- mconcat <$> some permpart
    void $ AT.char '='
    pr <- Set.fromList <$> some permission
    return (map (\p -> (p, pr)) pp)