module Propellor.Property.FlashKernel where
import Propellor.Base
import qualified Propellor.Property.File as File
import qualified Propellor.Property.Apt as Apt
import Propellor.Property.Mount
import Propellor.Types.Bootloader
import Propellor.Types.Info
type Machine = String
installed :: Machine -> Property (HasInfo + DebianLike)
installed :: Machine -> Property (HasInfo + DebianLike)
installed Machine
machine = Property DebianLike
-> Info
-> Property
(MetaTypes
'[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
forall k (metatypes' :: k) metatypes.
(MetaTypes metatypes' ~ (HasInfo + metatypes), SingI metatypes') =>
Property metatypes -> Info -> Property (MetaTypes metatypes')
setInfoProperty Property DebianLike
go ([BootloaderInstalled] -> Info
forall v. IsInfo v => v -> Info
toInfo [BootloaderInstalled
FlashKernelInstalled])
where
go :: CombinedType (Property DebianLike) (Property DebianLike)
go = Machine
"/etc/flash-kernel/machine" Machine -> [Machine] -> Property UnixLike
`File.hasContent` [Machine
machine]
Property UnixLike
-> Property DebianLike
-> CombinedType (Property UnixLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property DebianLike
flashKernel
Property DebianLike
-> Property UnixLike
-> CombinedType (Property DebianLike) (Property UnixLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Machine -> Property UnixLike
File.dirExists Machine
"/etc/flash-kernel"
Property DebianLike
-> Property DebianLike
-> CombinedType (Property DebianLike) (Property DebianLike)
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` [Machine] -> Property DebianLike
Apt.installed [Machine
"flash-kernel"]
flashKernel :: Property DebianLike
flashKernel :: Property DebianLike
flashKernel = Property UnixLike -> Property DebianLike
forall (p :: * -> *) (untightened :: [MetaType])
(tightened :: [MetaType]).
(TightenTargets p, TightenTargetsAllowed untightened tightened,
SingI tightened) =>
p (MetaTypes untightened) -> p (MetaTypes tightened)
tightenTargets (Property UnixLike -> Property DebianLike)
-> Property UnixLike -> Property DebianLike
forall a b. (a -> b) -> a -> b
$
Machine -> [Machine] -> UncheckedProperty UnixLike
cmdProperty Machine
"flash-kernel" [] UncheckedProperty UnixLike -> Result -> Property UnixLike
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
flashKernelMounted :: FilePath -> Property Linux
flashKernelMounted :: Machine -> Property Linux
flashKernelMounted Machine
mnt = Machine -> Props Linux -> Property Linux
forall k (metatypes :: k).
SingI metatypes =>
Machine
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties Machine
desc (Props Linux -> Property Linux) -> Props Linux -> Property Linux
forall a b. (a -> b) -> a -> b
$ Props UnixLike
props
Props UnixLike
-> Property Linux
-> Props
(MetaTypes
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux, 'Targeting 'OSFreeBSD]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
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 Linux
cleanupmounts
Props Linux
-> Property Linux
-> Props
(MetaTypes
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
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))
& Machine -> Machine -> Property Linux
bindMount Machine
"/dev" (Machine -> Machine
inmnt Machine
"/dev")
Props Linux
-> Property UnixLike
-> Props
(MetaTypes
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
'[ '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))
& Machine -> Machine -> Machine -> MountOpts -> Property UnixLike
mounted Machine
"proc" Machine
"proc" (Machine -> Machine
inmnt Machine
"/proc") MountOpts
forall a. Monoid a => a
mempty
Props Linux
-> Property UnixLike
-> Props
(MetaTypes
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
'[ '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))
& Machine -> Machine -> Machine -> MountOpts -> Property UnixLike
mounted Machine
"sysfs" Machine
"sys" (Machine -> Machine
inmnt Machine
"/sys") MountOpts
forall a. Monoid a => a
mempty
Props Linux
-> Property UnixLike
-> Props
(MetaTypes
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
'[ '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))
& Machine -> [Machine] -> UncheckedProperty UnixLike
inchroot Machine
"update-initramfs" [Machine
"-u"]
UncheckedProperty UnixLike -> Result -> Property UnixLike
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
Props Linux
-> Property UnixLike
-> Props
(MetaTypes
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
'[ '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))
& Machine -> [Machine] -> UncheckedProperty UnixLike
inchroot Machine
"flash-kernel" []
UncheckedProperty UnixLike -> Result -> Property UnixLike
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
Props Linux
-> Property Linux
-> Props
(MetaTypes
(Combine
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]
'[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
'Targeting 'OSArchLinux]))
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 Linux
cleanupmounts
where
desc :: Machine
desc = Machine
"flash-kernel run"
inmnt :: Machine -> Machine
inmnt Machine
f = Machine
mnt Machine -> Machine -> Machine
forall a. [a] -> [a] -> [a]
++ Machine
f
inchroot :: Machine -> [Machine] -> UncheckedProperty UnixLike
inchroot Machine
cmd [Machine]
ps = Machine -> [Machine] -> UncheckedProperty UnixLike
cmdProperty Machine
"chroot" ([Machine
mnt, Machine
cmd] [Machine] -> [Machine] -> [Machine]
forall a. [a] -> [a] -> [a]
++ [Machine]
ps)
cleanupmounts :: Property Linux
cleanupmounts :: Property Linux
cleanupmounts = Machine -> Propellor Result -> Property Linux
forall k (metatypes :: k).
SingI metatypes =>
Machine -> Propellor Result -> Property (MetaTypes metatypes)
property Machine
desc (Propellor Result -> Property Linux)
-> Propellor Result -> Property Linux
forall a b. (a -> b) -> a -> b
$ IO Result -> Propellor Result
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Result -> Propellor Result) -> IO Result -> Propellor Result
forall a b. (a -> b) -> a -> b
$ do
Machine -> IO ()
cleanup Machine
"/sys"
Machine -> IO ()
cleanup Machine
"/proc"
Machine -> IO ()
cleanup Machine
"/dev"
Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return Result
NoChange
where
cleanup :: Machine -> IO ()
cleanup Machine
m =
let mp :: Machine
mp = Machine -> Machine
inmnt Machine
m
in IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Machine -> IO Bool
isMounted Machine
mp) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Machine -> IO ()
umountLazy Machine
mp