-- | Maintainer: 2016 Evan Cofsky <evan@theunixman.com>
--
-- FreeBSD Poudriere properties

{-# Language GeneralizedNewtypeDeriving, DeriveDataTypeable #-}

module Propellor.Property.FreeBSD.Poudriere where

import Propellor.Base
import Propellor.Types.Info
import qualified Propellor.Property.FreeBSD.Pkg as Pkg
import qualified Propellor.Property.ZFS as ZFS
import qualified Propellor.Property.File as File

import Data.List
import qualified Data.Semigroup as Sem

poudriereConfigPath :: FilePath
poudriereConfigPath :: FilePath
poudriereConfigPath = FilePath
"/usr/local/etc/poudriere.conf"

newtype PoudriereConfigured = PoudriereConfigured String
	deriving (Typeable, b -> PoudriereConfigured -> PoudriereConfigured
NonEmpty PoudriereConfigured -> PoudriereConfigured
PoudriereConfigured -> PoudriereConfigured -> PoudriereConfigured
(PoudriereConfigured -> PoudriereConfigured -> PoudriereConfigured)
-> (NonEmpty PoudriereConfigured -> PoudriereConfigured)
-> (forall b.
    Integral b =>
    b -> PoudriereConfigured -> PoudriereConfigured)
-> Semigroup PoudriereConfigured
forall b.
Integral b =>
b -> PoudriereConfigured -> PoudriereConfigured
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> PoudriereConfigured -> PoudriereConfigured
$cstimes :: forall b.
Integral b =>
b -> PoudriereConfigured -> PoudriereConfigured
sconcat :: NonEmpty PoudriereConfigured -> PoudriereConfigured
$csconcat :: NonEmpty PoudriereConfigured -> PoudriereConfigured
<> :: PoudriereConfigured -> PoudriereConfigured -> PoudriereConfigured
$c<> :: PoudriereConfigured -> PoudriereConfigured -> PoudriereConfigured
Sem.Semigroup, Semigroup PoudriereConfigured
PoudriereConfigured
Semigroup PoudriereConfigured
-> PoudriereConfigured
-> (PoudriereConfigured
    -> PoudriereConfigured -> PoudriereConfigured)
-> ([PoudriereConfigured] -> PoudriereConfigured)
-> Monoid PoudriereConfigured
[PoudriereConfigured] -> PoudriereConfigured
PoudriereConfigured -> PoudriereConfigured -> PoudriereConfigured
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [PoudriereConfigured] -> PoudriereConfigured
$cmconcat :: [PoudriereConfigured] -> PoudriereConfigured
mappend :: PoudriereConfigured -> PoudriereConfigured -> PoudriereConfigured
$cmappend :: PoudriereConfigured -> PoudriereConfigured -> PoudriereConfigured
mempty :: PoudriereConfigured
$cmempty :: PoudriereConfigured
$cp1Monoid :: Semigroup PoudriereConfigured
Monoid, Int -> PoudriereConfigured -> ShowS
[PoudriereConfigured] -> ShowS
PoudriereConfigured -> FilePath
(Int -> PoudriereConfigured -> ShowS)
-> (PoudriereConfigured -> FilePath)
-> ([PoudriereConfigured] -> ShowS)
-> Show PoudriereConfigured
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [PoudriereConfigured] -> ShowS
$cshowList :: [PoudriereConfigured] -> ShowS
show :: PoudriereConfigured -> FilePath
$cshow :: PoudriereConfigured -> FilePath
showsPrec :: Int -> PoudriereConfigured -> ShowS
$cshowsPrec :: Int -> PoudriereConfigured -> ShowS
Show)

instance IsInfo PoudriereConfigured where
	propagateInfo :: PoudriereConfigured -> PropagateInfo
propagateInfo PoudriereConfigured
_ = Bool -> PropagateInfo
PropagateInfo Bool
False

poudriereConfigured :: PoudriereConfigured -> Bool
poudriereConfigured :: PoudriereConfigured -> Bool
poudriereConfigured (PoudriereConfigured FilePath
_) = Bool
True

setConfigured :: Property (HasInfo + FreeBSD)
setConfigured :: Property (HasInfo + FreeBSD)
setConfigured = Property
  (MetaTypes
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property (MetaTypes '[ 'WithInfo, 'Targeting 'OSFreeBSD])
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property
   (MetaTypes
      '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
 -> Property (MetaTypes '[ 'WithInfo, 'Targeting 'OSFreeBSD]))
-> Property
     (MetaTypes
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property (MetaTypes '[ 'WithInfo, 'Targeting 'OSFreeBSD])
forall a b. (a -> b) -> a -> b
$
	FilePath -> PoudriereConfigured -> Property (HasInfo + UnixLike)
forall v.
IsInfo v =>
FilePath -> v -> Property (HasInfo + UnixLike)
pureInfoProperty FilePath
"Poudriere Configured" (FilePath -> PoudriereConfigured
PoudriereConfigured FilePath
"")

poudriere :: Poudriere -> Property (HasInfo + FreeBSD)
poudriere :: Poudriere -> Property (HasInfo + FreeBSD)
poudriere conf :: Poudriere
conf@(Poudriere FilePath
_ FilePath
_ FilePath
_ Bool
_ FilePath
_ FilePath
_ Maybe PoudriereZFS
zfs) = Property FreeBSD
prop
	Property FreeBSD
-> Property FreeBSD
-> CombinedType (Property FreeBSD) (Property FreeBSD)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` FilePath -> Property FreeBSD
Pkg.installed FilePath
"poudriere"
	Property FreeBSD
-> Property (MetaTypes '[ 'WithInfo, 'Targeting 'OSFreeBSD])
-> CombinedType
     (Property FreeBSD)
     (Property (MetaTypes '[ 'WithInfo, 'Targeting 'OSFreeBSD]))
forall x y. Combines x y => x -> y -> CombinedType x y
`before` Property (MetaTypes '[ 'WithInfo, 'Targeting 'OSFreeBSD])
Property (HasInfo + FreeBSD)
setConfigured
  where
	confProp :: Property FreeBSD
	confProp :: Property FreeBSD
confProp = Property UnixLike -> Property FreeBSD
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property UnixLike -> Property FreeBSD)
-> Property UnixLike -> Property FreeBSD
forall a b. (a -> b) -> a -> b
$
		FilePath -> [FilePath] -> Property UnixLike
File.containsLines FilePath
poudriereConfigPath (Poudriere -> [FilePath]
forall a. ToShellConfigLines a => a -> [FilePath]
toLines Poudriere
conf)
	setZfs :: PoudriereZFS -> Property UnixLike
setZfs (PoudriereZFS ZFS
z ZFSProperties
p) = ZFS -> ZFSProperties -> Property ZFSOS
ZFS.zfsSetProperties ZFS
z ZFSProperties
p Property UnixLike -> FilePath -> Property UnixLike
forall p. IsProp p => p -> FilePath -> p
`describe` FilePath
"Configuring Poudriere with ZFS"
	prop :: Property FreeBSD
	prop :: Property FreeBSD
prop
		| Maybe PoudriereZFS -> Bool
forall a. Maybe a -> Bool
isJust Maybe PoudriereZFS
zfs = ((PoudriereZFS -> Property UnixLike
setZfs (PoudriereZFS -> Property UnixLike)
-> PoudriereZFS -> Property UnixLike
forall a b. (a -> b) -> a -> b
$ Maybe PoudriereZFS -> PoudriereZFS
forall a. HasCallStack => Maybe a -> a
fromJust Maybe PoudriereZFS
zfs) Property UnixLike
-> Property FreeBSD
-> CombinedType (Property UnixLike) (Property FreeBSD)
forall x y. Combines x y => x -> y -> CombinedType x y
`before` Property FreeBSD
confProp)
		| Bool
otherwise = Property FreeBSD
confProp Property FreeBSD -> FilePath -> Property FreeBSD
forall p. IsProp p => p -> FilePath -> p
`describe` FilePath
"Configuring Poudriere without ZFS"

poudriereCommand :: String -> [String] -> (String, [String])
poudriereCommand :: FilePath -> [FilePath] -> (FilePath, [FilePath])
poudriereCommand FilePath
cmd [FilePath]
args = (FilePath
"poudriere", FilePath
cmdFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
args)

runPoudriere :: String -> [String] -> IO [String]
runPoudriere :: FilePath -> [FilePath] -> IO [FilePath]
runPoudriere FilePath
cmd [FilePath]
args =
	let
		(FilePath
p, [FilePath]
a) = FilePath -> [FilePath] -> (FilePath, [FilePath])
poudriereCommand FilePath
cmd [FilePath]
args
	in
		FilePath -> [FilePath]
lines (FilePath -> [FilePath]) -> IO FilePath -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> [FilePath] -> IO FilePath
readProcess FilePath
p [FilePath]
a

listJails :: IO [String]
listJails :: IO [FilePath]
listJails = (FilePath -> Maybe FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([FilePath] -> Maybe FilePath
forall a. [a] -> Maybe a
headMaybe ([FilePath] -> Maybe FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [FilePath] -> [FilePath]
forall a. Int -> [a] -> [a]
take Int
1 ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
words)
	([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> [FilePath] -> IO [FilePath]
runPoudriere FilePath
"jail" [FilePath
"-l", FilePath
"-q"]

jailExists :: Jail -> IO Bool
jailExists :: Jail -> IO Bool
jailExists (Jail FilePath
name FBSDVersion
_ PoudriereArch
_) = [FilePath] -> [FilePath] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isInfixOf [FilePath
name] ([FilePath] -> Bool) -> IO [FilePath] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [FilePath]
listJails

jail :: Jail -> Property FreeBSD
jail :: Jail -> Property FreeBSD
jail j :: Jail
j@(Jail FilePath
name FBSDVersion
version PoudriereArch
arch) = Property UnixLike -> Property FreeBSD
forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property UnixLike -> Property FreeBSD)
-> Property UnixLike -> Property FreeBSD
forall a b. (a -> b) -> a -> b
$
	let
		chk :: Propellor Bool
chk = do
			Bool
c <- PoudriereConfigured -> Bool
poudriereConfigured (PoudriereConfigured -> Bool)
-> Propellor PoudriereConfigured -> Propellor Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Propellor PoudriereConfigured
forall v. IsInfo v => Propellor v
askInfo
			Bool
nx <- IO Bool -> Propellor Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Propellor Bool) -> IO Bool -> Propellor Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Jail -> IO Bool
jailExists Jail
j
			Bool -> Propellor Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Propellor Bool) -> Bool -> Propellor Bool
forall a b. (a -> b) -> a -> b
$ Bool
c Bool -> Bool -> Bool
&& Bool
nx

		(FilePath
cmd, [FilePath]
args) = FilePath -> [FilePath] -> (FilePath, [FilePath])
poudriereCommand FilePath
"jail"  [FilePath
"-c", FilePath
"-j", FilePath
name, FilePath
"-a", PoudriereArch -> FilePath
forall t. ConfigurableValue t => t -> FilePath
val PoudriereArch
arch, FilePath
"-v", FBSDVersion -> FilePath
forall t. ConfigurableValue t => t -> FilePath
val FBSDVersion
version]
		createJail :: UncheckedProperty UnixLike
createJail = FilePath -> [FilePath] -> UncheckedProperty UnixLike
cmdProperty FilePath
cmd [FilePath]
args
	in
		Propellor Bool -> UncheckedProperty UnixLike -> Property UnixLike
forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check Propellor Bool
chk UncheckedProperty UnixLike
createJail
			Property UnixLike -> FilePath -> Property UnixLike
forall p. IsProp p => p -> FilePath -> p
`describe` [FilePath] -> FilePath
unwords [FilePath
"Create poudriere jail", FilePath
name]

data JailInfo = JailInfo String

data Poudriere = Poudriere
	{ Poudriere -> FilePath
_resolvConf :: String
	, Poudriere -> FilePath
_freebsdHost :: String
	, Poudriere -> FilePath
_baseFs :: String
	, Poudriere -> Bool
_usePortLint :: Bool
	, Poudriere -> FilePath
_distFilesCache :: FilePath
	, Poudriere -> FilePath
_svnHost :: String
	, Poudriere -> Maybe PoudriereZFS
_zfs :: Maybe PoudriereZFS
	}

defaultConfig :: Poudriere
defaultConfig :: Poudriere
defaultConfig = FilePath
-> FilePath
-> FilePath
-> Bool
-> FilePath
-> FilePath
-> Maybe PoudriereZFS
-> Poudriere
Poudriere
	FilePath
"/etc/resolv.conf"
	FilePath
"ftp://ftp5.us.FreeBSD.org"
	FilePath
"/usr/local/poudriere"
	Bool
True
	FilePath
"/usr/ports/distfiles"
	FilePath
"svn.freebsd.org"
	Maybe PoudriereZFS
forall a. Maybe a
Nothing

data PoudriereZFS = PoudriereZFS ZFS.ZFS ZFS.ZFSProperties

data Jail = Jail String FBSDVersion PoudriereArch

data PoudriereArch = I386 | AMD64 deriving (PoudriereArch -> PoudriereArch -> Bool
(PoudriereArch -> PoudriereArch -> Bool)
-> (PoudriereArch -> PoudriereArch -> Bool) -> Eq PoudriereArch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PoudriereArch -> PoudriereArch -> Bool
$c/= :: PoudriereArch -> PoudriereArch -> Bool
== :: PoudriereArch -> PoudriereArch -> Bool
$c== :: PoudriereArch -> PoudriereArch -> Bool
Eq)

instance ConfigurableValue PoudriereArch where
	val :: PoudriereArch -> FilePath
val PoudriereArch
I386 = FilePath
"i386"
	val PoudriereArch
AMD64 = FilePath
"amd64"

fromArchitecture :: Architecture -> PoudriereArch
fromArchitecture :: Architecture -> PoudriereArch
fromArchitecture Architecture
X86_64 = PoudriereArch
AMD64
fromArchitecture Architecture
X86_32 = PoudriereArch
I386
fromArchitecture Architecture
_ = FilePath -> PoudriereArch
forall a. HasCallStack => FilePath -> a
error FilePath
"Not a valid Poudriere architecture."

yesNoProp :: Bool -> String
yesNoProp :: Bool -> FilePath
yesNoProp Bool
b = if Bool
b then FilePath
"yes" else FilePath
"no"

instance ToShellConfigLines Poudriere where
	toAssoc :: Poudriere -> [(FilePath, FilePath)]
toAssoc Poudriere
c = ((FilePath, Poudriere -> FilePath) -> (FilePath, FilePath))
-> [(FilePath, Poudriere -> FilePath)] -> [(FilePath, FilePath)]
forall a b. (a -> b) -> [a] -> [b]
map (\(FilePath
k, Poudriere -> FilePath
f) -> (FilePath
k, Poudriere -> FilePath
f Poudriere
c))
		[ (FilePath
"RESOLV_CONF", Poudriere -> FilePath
_resolvConf)
		, (FilePath
"FREEBSD_HOST", Poudriere -> FilePath
_freebsdHost)
		, (FilePath
"BASEFS", Poudriere -> FilePath
_baseFs)
		, (FilePath
"USE_PORTLINT", Bool -> FilePath
yesNoProp (Bool -> FilePath) -> (Poudriere -> Bool) -> Poudriere -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Poudriere -> Bool
_usePortLint)
		, (FilePath
"DISTFILES_CACHE", Poudriere -> FilePath
_distFilesCache)
		, (FilePath
"SVN_HOST", Poudriere -> FilePath
_svnHost)
		] [(FilePath, FilePath)]
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. [a] -> [a] -> [a]
++ [(FilePath, FilePath)]
-> (PoudriereZFS -> [(FilePath, FilePath)])
-> Maybe PoudriereZFS
-> [(FilePath, FilePath)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [ (FilePath
"NO_ZFS", FilePath
"yes") ] PoudriereZFS -> [(FilePath, FilePath)]
forall a. ToShellConfigLines a => a -> [(FilePath, FilePath)]
toAssoc (Poudriere -> Maybe PoudriereZFS
_zfs Poudriere
c)

instance ToShellConfigLines PoudriereZFS where
	toAssoc :: PoudriereZFS -> [(FilePath, FilePath)]
toAssoc (PoudriereZFS (ZFS.ZFS (ZFS.ZPool FilePath
pool) ZDataset
dataset) ZFSProperties
_) =
		[ (FilePath
"NO_ZFS", FilePath
"no")
		, (FilePath
"ZPOOL", FilePath
pool)
		, (FilePath
"ZROOTFS", ZDataset -> FilePath
forall t. ConfigurableValue t => t -> FilePath
val ZDataset
dataset)
		]

type ConfigLine = String
type ConfigFile = [ConfigLine]

class ToShellConfigLines a where
	toAssoc :: a -> [(String, String)]

	toLines :: a -> [ConfigLine]
	toLines a
c = ((FilePath, FilePath) -> FilePath)
-> [(FilePath, FilePath)] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (\(FilePath
k, FilePath
v) -> FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"=" [FilePath
k, FilePath
v]) (a -> [(FilePath, FilePath)]
forall a. ToShellConfigLines a => a -> [(FilePath, FilePath)]
toAssoc a
c)

confFile :: FilePath
confFile :: FilePath
confFile = FilePath
"/usr/local/etc/poudriere.conf"