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

{-# LANGUAGE DeriveDataTypeable #-}

module Propellor.Property.Schroot where

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

data UseOverlays = UseOverlays deriving (UseOverlays -> UseOverlays -> Bool
(UseOverlays -> UseOverlays -> Bool)
-> (UseOverlays -> UseOverlays -> Bool) -> Eq UseOverlays
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UseOverlays -> UseOverlays -> Bool
$c/= :: UseOverlays -> UseOverlays -> Bool
== :: UseOverlays -> UseOverlays -> Bool
$c== :: UseOverlays -> UseOverlays -> Bool
Eq, Int -> UseOverlays -> ShowS
[UseOverlays] -> ShowS
UseOverlays -> String
(Int -> UseOverlays -> ShowS)
-> (UseOverlays -> String)
-> ([UseOverlays] -> ShowS)
-> Show UseOverlays
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UseOverlays] -> ShowS
$cshowList :: [UseOverlays] -> ShowS
show :: UseOverlays -> String
$cshow :: UseOverlays -> String
showsPrec :: Int -> UseOverlays -> ShowS
$cshowsPrec :: Int -> UseOverlays -> ShowS
Show, Typeable)

-- | Indicate that a schroots on a host should use @union-type=overlay@
--
-- Setting this property does not actually ensure that the line
-- @union-type=overlay@ is present in any schroot config files.  See
-- 'Propellor.Property.Sbuild.built' for example usage.
useOverlays :: Property (HasInfo + UnixLike)
useOverlays :: Property (HasInfo + UnixLike)
useOverlays = String -> InfoVal UseOverlays -> Property (HasInfo + UnixLike)
forall v. IsInfo v => String -> v -> Property (HasInfo + UnixLike)
pureInfoProperty String
"use schroot overlays" (UseOverlays -> InfoVal UseOverlays
forall v. v -> InfoVal v
InfoVal UseOverlays
UseOverlays)

-- | Gets whether a host uses overlays.
usesOverlays :: Propellor Bool
usesOverlays :: Propellor Bool
usesOverlays = Maybe UseOverlays -> Bool
forall a. Maybe a -> Bool
isJust (Maybe UseOverlays -> Bool)
-> (InfoVal UseOverlays -> Maybe UseOverlays)
-> InfoVal UseOverlays
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InfoVal UseOverlays -> Maybe UseOverlays
forall v. InfoVal v -> Maybe v
fromInfoVal
	(InfoVal UseOverlays -> Bool)
-> Propellor (InfoVal UseOverlays) -> Propellor Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Propellor (InfoVal UseOverlays)
forall v. IsInfo v => Propellor v
askInfo :: Propellor (InfoVal UseOverlays))

-- | Configure schroot such that all schroots with @union-type=overlay@ in their
-- configuration will run their overlays in a tmpfs.
--
-- Implicitly sets 'useOverlays' info property.
--
-- Shell script from <https://wiki.debian.org/sbuild>.
overlaysInTmpfs :: RevertableProperty (HasInfo + DebianLike) UnixLike
overlaysInTmpfs :: RevertableProperty (HasInfo + DebianLike) UnixLike
overlaysInTmpfs = (Property
  (Sing
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
Property (HasInfo + UnixLike)
go Property
  (Sing
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property DebianLike
-> CombinedType
     (Property
        (Sing
           '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
     (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property DebianLike
installed) Property
  (Sing '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
-> Property UnixLike
-> RevertableProperty
     (Sing '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
     UnixLike
forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property UnixLike
undo
  where
	f :: String
f = String
"/etc/schroot/setup.d/04tmpfs"
	go :: Property (HasInfo + UnixLike)
	go :: Property (HasInfo + UnixLike)
go = String
-> Props
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall k (metatypes :: k).
SingI metatypes =>
String
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties String
"schroot overlays in tmpfs" (Props
   (Sing
      '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
 -> Property
      (Sing
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
            'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
-> Props
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
		Props UnixLike
-> Property
     (Sing
        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Props
     (MetaTypes
        (Combine
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
           '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
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))
& Property
  (Sing
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
Property (HasInfo + UnixLike)
useOverlays
		Props
  (Sing
     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
-> Property UnixLike
-> Props
     (MetaTypes
        (Combine
           '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
           '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
              'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]))
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
f String -> [String] -> Property UnixLike
`File.hasContent`
			[ String
"#!/bin/sh"
			, String
""
			, String
"set -e"
			, String
""
			, String
". \"$SETUP_DATA_DIR/common-data\""
			, String
". \"$SETUP_DATA_DIR/common-functions\""
			, String
". \"$SETUP_DATA_DIR/common-config\""
			, String
""
			, String
""
			, String
"if [ $STAGE = \"setup-start\" ]; then"
			, String
"  mount -t tmpfs overlay /var/lib/schroot/union/overlay"
			, String
"elif [ $STAGE = \"setup-recover\" ]; then"
			, String
"  mount -t tmpfs overlay /var/lib/schroot/union/overlay"
			, String
"elif [ $STAGE = \"setup-stop\" ]; then"
			, String
"  umount -f /var/lib/schroot/union/overlay"
			, String
"fi"
			]
		Property UnixLike
-> Property UnixLike
-> CombinedType (Property UnixLike) (Property UnixLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` (String
f String -> FileMode -> Property UnixLike
`File.mode` [FileMode] -> FileMode
combineModes ([FileMode]
readModes [FileMode] -> [FileMode] -> [FileMode]
forall a. [a] -> [a] -> [a]
++ [FileMode]
executeModes))
	undo :: Property UnixLike
undo = String -> Property UnixLike
File.notPresent String
f

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