-- | 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 :: String
poudriereConfigPath = String
"/usr/local/etc/poudriere.conf"

newtype PoudriereConfigured = PoudriereConfigured String
	deriving (Typeable, 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 :: forall b.
Integral b =>
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
Monoid, Int -> PoudriereConfigured -> String -> String
[PoudriereConfigured] -> String -> String
PoudriereConfigured -> String
(Int -> PoudriereConfigured -> String -> String)
-> (PoudriereConfigured -> String)
-> ([PoudriereConfigured] -> String -> String)
-> Show PoudriereConfigured
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [PoudriereConfigured] -> String -> String
$cshowList :: [PoudriereConfigured] -> String -> String
show :: PoudriereConfigured -> String
$cshow :: PoudriereConfigured -> String
showsPrec :: Int -> PoudriereConfigured -> String -> String
$cshowsPrec :: Int -> PoudriereConfigured -> String -> String
Show)

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

poudriereConfigured :: PoudriereConfigured -> Bool
poudriereConfigured :: PoudriereConfigured -> Bool
poudriereConfigured (PoudriereConfigured String
_) = 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
$
	String -> PoudriereConfigured -> Property (HasInfo + UnixLike)
forall v. IsInfo v => String -> v -> Property (HasInfo + UnixLike)
pureInfoProperty String
"Poudriere Configured" (String -> PoudriereConfigured
PoudriereConfigured String
"")

poudriere :: Poudriere -> Property (HasInfo + FreeBSD)
poudriere :: Poudriere -> Property (HasInfo + FreeBSD)
poudriere conf :: Poudriere
conf@(Poudriere String
_ String
_ String
_ Bool
_ String
_ String
_ 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` String -> Property FreeBSD
Pkg.installed String
"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
$
		String -> [String] -> Property UnixLike
File.containsLines String
poudriereConfigPath (Poudriere -> [String]
forall a. ToShellConfigLines a => a -> [String]
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 -> String -> Property UnixLike
forall p. IsProp p => p -> String -> p
`describe` String
"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 -> String -> Property FreeBSD
forall p. IsProp p => p -> String -> p
`describe` String
"Configuring Poudriere without ZFS"

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

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

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

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

jail :: Jail -> Property FreeBSD
jail :: Jail -> Property FreeBSD
jail j :: Jail
j@(Jail String
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

		(String
cmd, [String]
args) = String -> [String] -> (String, [String])
poudriereCommand String
"jail"  [String
"-c", String
"-j", String
name, String
"-a", PoudriereArch -> String
forall t. ConfigurableValue t => t -> String
val PoudriereArch
arch, String
"-v", FBSDVersion -> String
forall t. ConfigurableValue t => t -> String
val FBSDVersion
version]
		createJail :: UncheckedProperty UnixLike
createJail = String -> [String] -> UncheckedProperty UnixLike
cmdProperty String
cmd [String]
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 -> String -> Property UnixLike
forall p. IsProp p => p -> String -> p
`describe` [String] -> String
unwords [String
"Create poudriere jail", String
name]

data JailInfo = JailInfo String

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

defaultConfig :: Poudriere
defaultConfig :: Poudriere
defaultConfig = String
-> String
-> String
-> Bool
-> String
-> String
-> Maybe PoudriereZFS
-> Poudriere
Poudriere
	String
"/etc/resolv.conf"
	String
"ftp://ftp5.us.FreeBSD.org"
	String
"/usr/local/poudriere"
	Bool
True
	String
"/usr/ports/distfiles"
	String
"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 -> String
val PoudriereArch
I386 = String
"i386"
	val PoudriereArch
AMD64 = String
"amd64"

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

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

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

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

type ConfigLine = String
type ConfigFile = [ConfigLine]

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

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

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