module Propellor.Property.Group where

import Propellor.Base
import Propellor.Property.User (hasGroup)

type GID = Int

exists :: Group -> Maybe GID -> Property UnixLike
exists :: Group -> Maybe GID -> Property UnixLike
exists (Group String
group') Maybe GID
mgid = IO Bool -> UncheckedProperty UnixLike -> Property UnixLike
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check IO Bool
test (String -> [String] -> UncheckedProperty UnixLike
cmdProperty String
"addgroup" (Maybe GID -> [String]
forall a. Show a => Maybe a -> [String]
args Maybe GID
mgid))
	Property UnixLike -> String -> Property UnixLike
forall p. IsProp p => p -> String -> p
`describe` [String] -> String
unwords [String
"group", String
group']
  where
	groupFile :: String
groupFile = String
"/etc/group"
	test :: IO Bool
test = Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
group' ([String] -> Bool) -> (String -> [String]) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words (String -> Bool) -> IO String -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> IO String
readProcess String
"cut" [String
"-d:", String
"-f1", String
groupFile]
	args :: Maybe a -> [String]
args Maybe a
Nothing = [String
group']
	args (Just a
gid) = [String
"--gid", a -> String
forall a. Show a => a -> String
show a
gid, String
group']

hasUser :: Group -> User -> Property DebianLike
hasUser :: Group -> User -> Property DebianLike
hasUser = (User -> Group -> Property DebianLike)
-> Group -> User -> Property DebianLike
forall a b c. (a -> b -> c) -> b -> a -> c
flip User -> Group -> Property DebianLike
hasGroup