-- | Maintainer: Sean Whitton <spwhitton@spwhitton.name>

module Propellor.Property.Ccache (
	hasCache,
	hasLimits,
	Limit(..),
	DataSize,
) where

import Propellor.Base
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt

import Utility.DataUnits
import System.Posix.Files
import qualified Data.Semigroup as Sem

-- | Limits on the size of a ccache
data Limit
	-- | The maximum size of the cache, as a string such as "4G"
	= MaxSize DataSize
	-- | The maximum number of files in the cache
	| MaxFiles Integer
	-- | A cache with no limit specified
	| NoLimit
	| Limit :+ Limit

instance Sem.Semigroup Limit where
	<> :: Limit -> Limit -> Limit
(<>) = Limit -> Limit -> Limit
(:+)

instance Monoid Limit where
	mempty :: Limit
mempty  = Limit
NoLimit
	mappend :: Limit -> Limit -> Limit
mappend = forall a. Semigroup a => a -> a -> a
(Sem.<>)

-- | A string that will be parsed to get a data size.
--
-- Examples: "100 megabytes" or "0.5tb"
type DataSize = String

maxSizeParam :: DataSize -> Maybe String
maxSizeParam :: String -> Maybe String
maxSizeParam String
s = [Unit] -> String -> Maybe Integer
readSize [Unit]
dataUnits String
s
	forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Integer
sz -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String
"--max-size=" forall a. [a] -> [a] -> [a]
++ Integer -> String
ccacheSizeUnits Integer
sz

-- Generates size units as used in ccache.conf.  The smallest unit we can
-- specify in a ccache config files is a kilobyte
ccacheSizeUnits :: Integer -> String
ccacheSizeUnits :: Integer -> String
ccacheSizeUnits Integer
sz = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= Char
' ') ([Unit] -> Bool -> Integer -> String
roughSize [Unit]
cfgfileunits Bool
True Integer
sz)
  where
	cfgfileunits :: [Unit]
	cfgfileunits :: [Unit]
cfgfileunits =
	        [ Integer -> String -> String -> Unit
Unit (Integer -> Integer
p Integer
4) String
"Ti" String
"terabyte"
		, Integer -> String -> String -> Unit
Unit (Integer -> Integer
p Integer
3) String
"Gi" String
"gigabyte"
		, Integer -> String -> String -> Unit
Unit (Integer -> Integer
p Integer
2) String
"Mi" String
"megabyte"
		, Integer -> String -> String -> Unit
Unit (Integer -> Integer
p Integer
1) String
"Ki" String
"kilobyte"
		]
	p :: Integer -> Integer
	p :: Integer -> Integer
p Integer
n = Integer
1024forall a b. (Num a, Integral b) => a -> b -> a
^Integer
n

-- | Set limits on a given ccache
hasLimits :: FilePath -> Limit -> Property DebianLike
String
path hasLimits :: String -> Limit -> Property DebianLike
`hasLimits` Limit
limit = Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
go forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
installed
  where
	go :: Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
go
		| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
params' = forall {k} (t :: k). SingI t => Property (MetaTypes t)
doNothing
		-- We invoke ccache itself to set the limits, so that it can
		-- handle replacing old limits in the config file, duplicates
		-- etc.
		| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
errors =
			String
-> [String]
-> [(String, String)]
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdPropertyEnv String
"ccache" [String]
params' [(String
"CCACHE_DIR", String
path)]
			forall (p :: * -> *) i.
Checkable p i =>
p i -> String -> Property i
`changesFileContent` (String
path String -> String -> String
</> String
"ccache.conf")
		| Bool
otherwise = forall {k} (metatypes :: k).
SingI metatypes =>
String -> Propellor Result -> Property (MetaTypes metatypes)
property String
"couldn't parse ccache limits" forall a b. (a -> b) -> a -> b
$
			forall (m :: * -> *) a. MonadIO m => String -> m a
errorMessage forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines [String]
errors

	params :: [Either String String]
params = Limit -> [Either String String]
limitToParams Limit
limit
	([String]
errors, [String]
params') = forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either String String]
params

limitToParams :: Limit -> [Either String String]
limitToParams :: Limit -> [Either String String]
limitToParams Limit
NoLimit = []
limitToParams (MaxSize String
s) = case String -> Maybe String
maxSizeParam String
s of
	Just String
param -> [forall a b. b -> Either a b
Right String
param]
	Maybe String
Nothing -> [forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"unable to parse data size " forall a. [a] -> [a] -> [a]
++ String
s]
limitToParams (MaxFiles Integer
f) = [forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ String
"--max-files=" forall a. [a] -> [a] -> [a]
++ forall t. ConfigurableValue t => t -> String
val Integer
f]
limitToParams (Limit
l1 :+ Limit
l2) = Limit -> [Either String String]
limitToParams Limit
l1 forall a. Semigroup a => a -> a -> a
<> Limit -> [Either String String]
limitToParams Limit
l2

-- | Configures a ccache in /var/cache for a group
--
-- If you say
--
-- > & (Group "foo") `Ccache.hasGroupCache`
-- > 	(Ccache.MaxSize "4G" <> Ccache.MaxFiles 10000)
--
-- you instruct propellor to create a ccache in /var/cache/ccache-foo owned and
-- writeable by the foo group, with a maximum cache size of 4GB or 10000 files.
hasCache :: Group -> Limit -> RevertableProperty DebianLike UnixLike
group :: Group
group@(Group String
g) hasCache :: Group
-> Limit
-> RevertableProperty
     DebianLike
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
`hasCache` Limit
limit = (Property DebianLike
make forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
installed) forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
delete
  where
	make :: Property
  (MetaTypes
     (Combine
        (Combine
           (Combine
              '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                 'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
              '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                 'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
make = forall {k} (metatypes :: k).
SingI metatypes =>
String
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
propertyList (String
"ccache for " forall a. [a] -> [a] -> [a]
++ String
g forall a. [a] -> [a] -> [a]
++ String
" group exists") forall a b. (a -> b) -> a -> b
$ Props
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
props
			forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& String
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
File.dirExists String
path
			forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& String
-> User
-> Group
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
File.ownerGroup String
path (String -> User
User String
"root") Group
group
			forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& String
-> FileMode
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
File.mode String
path ([FileMode] -> FileMode
combineModes forall a b. (a -> b) -> a -> b
$
					[FileMode]
readModes forall a. [a] -> [a] -> [a]
++ [FileMode]
executeModes forall a. [a] -> [a] -> [a]
++
					[ FileMode
ownerWriteMode
					, FileMode
groupWriteMode
					, FileMode
setGroupIDMode
					]) forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
fixSetgidBit
				-- here, we use onChange to catch upgrades from
				-- 3.0.5 where the setGroupIDMode line was not
				-- present
			forall {a} p (y :: [a]) (x :: [a]).
(IsProp p, MetaTypes y ~ GetMetaTypes p,
 CheckCombinableNote x y (NoteFor ('Text "&"))) =>
Props (MetaTypes x) -> p -> Props (MetaTypes (Combine x y))
& String -> Limit -> Property DebianLike
hasLimits String
path Limit
limit

	delete :: Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
delete = forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check (String -> IO Bool
doesDirectoryExist String
path) forall a b. (a -> b) -> a -> b
$
		String
-> [String]
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdProperty String
"rm" [String
"-r", String
path] forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
		forall p. IsProp p => p -> String -> p
`describe` (String
"ccache for " forall a. [a] -> [a] -> [a]
++ String
g forall a. [a] -> [a] -> [a]
++ String
" does not exist")

	-- Here we deal with a bug in Propellor 3.0.5.  If the ccache was
	-- created with that version, it will not have the setgid bit set.  That
	-- means its subdirectories won't have inherited the setgid bit, and
	-- then the files in those directories won't be owned by group sbuild.
	-- This breaks ccache.
	fixSetgidBit :: Property UnixLike
	fixSetgidBit :: Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
fixSetgidBit =
		(String
-> [String]
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdProperty String
"find"
			[ String
path
			, String
"-type", String
"d"
			, String
"-exec", String
"chmod", String
"g+s"
			, String
"{}", String
"+"
			] forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange)
		forall x y. Combines x y => x -> y -> CombinedType x y
`before`
		(String
-> [String]
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdProperty String
"chown"
			[ String
"-R"
			, String
"root:" forall a. [a] -> [a] -> [a]
++ String
g
			, String
path
			] forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange)

	path :: String
path = String
"/var/cache/ccache-" forall a. [a] -> [a] -> [a]
++ String
g

installed :: Property DebianLike
installed :: Property DebianLike
installed = [String] -> Property DebianLike
Apt.installed [String
"ccache"]