-- | 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
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
[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
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 = forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$
	forall v.
IsInfo v =>
String
-> v
-> Property
     (HasInfo
      + MetaTypes
          '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
             'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
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
	forall x y. Combines x y => x -> y -> CombinedType x y
`requires` String -> Property FreeBSD
Pkg.installed String
"poudriere"
	forall x y. Combines x y => x -> y -> CombinedType x y
`before` Property (HasInfo + FreeBSD)
setConfigured
  where
	confProp :: Property FreeBSD
	confProp :: Property FreeBSD
confProp = forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$
		String
-> [String]
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
File.containsLines String
poudriereConfigPath (forall a. ToShellConfigLines a => a -> [String]
toLines Poudriere
conf)
	setZfs :: PoudriereZFS
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
setZfs (PoudriereZFS ZFS
z ZFSProperties
p) = ZFS -> ZFSProperties -> Property ZFSOS
ZFS.zfsSetProperties ZFS
z ZFSProperties
p forall p. IsProp p => p -> String -> p
`describe` String
"Configuring Poudriere with ZFS"
	prop :: Property FreeBSD
	prop :: Property FreeBSD
prop
		| forall a. Maybe a -> Bool
isJust Maybe PoudriereZFS
zfs = ((PoudriereZFS
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
setZfs forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust Maybe PoudriereZFS
zfs) forall x y. Combines x y => x -> y -> CombinedType x y
`before` Property FreeBSD
confProp)
		| Bool
otherwise = Property FreeBSD
confProp 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
cmdforall 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 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 = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall a. [a] -> Maybe a
headMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words)
	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
_) = forall a. Eq a => [a] -> [a] -> Bool
isInfixOf [String
name] 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) = forall (p :: * -> *) (untightened :: [MetaType])
       (tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
 SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets forall a b. (a -> b) -> a -> b
$
	let
		chk :: Propellor Bool
chk = do
			Bool
c <- PoudriereConfigured -> Bool
poudriereConfigured forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall v. IsInfo v => Propellor v
askInfo
			Bool
nx <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Jail -> IO Bool
jailExists Jail
j
			forall (m :: * -> *) a. Monad m => a -> m a
return 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", forall t. ConfigurableValue t => t -> String
val PoudriereArch
arch, String
"-v", forall t. ConfigurableValue t => t -> String
val FBSDVersion
version]
		createJail :: UncheckedProperty
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
createJail = String
-> [String]
-> UncheckedProperty
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
cmdProperty String
cmd [String]
args
	in
		forall (p :: * -> *) i (m :: * -> *).
(Checkable p i, LiftPropellor m) =>
m Bool -> p i -> Property i
check Propellor Bool
chk UncheckedProperty
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
createJail
			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"
	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
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
_ = 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 = 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 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)
		] forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe [ (String
"NO_ZFS", String
"yes") ] 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", 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 = forall a b. (a -> b) -> [a] -> [b]
map (\(String
k, String
v) -> forall a. [a] -> [[a]] -> [a]
intercalate String
"=" [String
k, String
v]) (forall a. ToShellConfigLines a => a -> [(String, String)]
toAssoc a
c)

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