-- | 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
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
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
   + MetaTypes
       '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
          'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
useOverlays = forall v.
IsInfo v =>
String
-> v
-> Property
     (HasInfo
      + MetaTypes
          '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
             'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
pureInfoProperty String
"use schroot overlays" (forall v. v -> InfoVal v
InfoVal UseOverlays
UseOverlays)

-- | Gets whether a host uses overlays.
usesOverlays :: Propellor Bool
usesOverlays :: Propellor Bool
usesOverlays = forall a. Maybe a -> Bool
isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. InfoVal v -> Maybe v
fromInfoVal
	forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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)
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
overlaysInTmpfs = (Property
  (HasInfo
   + 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) forall setupmetatypes undometatypes.
Property setupmetatypes
-> Property undometatypes
-> RevertableProperty setupmetatypes undometatypes
<!> Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
undo
  where
	f :: String
f = String
"/etc/schroot/setup.d/04tmpfs"
	go :: Property (HasInfo + UnixLike)
	go :: Property
  (HasInfo
   + MetaTypes
       '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
          'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
go = forall {k} (metatypes :: k).
SingI metatypes =>
String
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties String
"schroot overlays in tmpfs" 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))
& Property
  (HasInfo
   + MetaTypes
       '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
          'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
useOverlays
		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
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
`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"
			]
		forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` (String
f String
-> FileMode
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
`File.mode` [FileMode] -> FileMode
combineModes ([FileMode]
readModes forall a. [a] -> [a] -> [a]
++ [FileMode]
executeModes))
	undo :: Property
  (MetaTypes
     '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
        'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
undo = String
-> Property
     (MetaTypes
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD])
File.notPresent String
f

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