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
+ MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
installed Machine
machine = forall {k} (metatypes' :: k) metatypes.
(MetaTypes metatypes' ~ (HasInfo + metatypes), SingI metatypes') =>
Property metatypes -> Info -> Property (MetaTypes metatypes')
setInfoProperty Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
go (forall v. IsInfo v => v -> Info
toInfo [BootloaderInstalled
FlashKernelInstalled])
where
go :: CombinedType
(Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
(Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
go = [Machine]
-> Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
Apt.installed [Machine
"flash-kernel"]
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Property UnixLike
configured
forall x y. Combines x y => x -> y -> CombinedType x y
`onChange` Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
flashKernel
configured :: CombinedType (Property UnixLike) (Property UnixLike)
configured = (Machine
"/etc/flash-kernel/machine" Machine -> [Machine] -> Property UnixLike
`File.hasContent` [Machine
machine])
forall x y. Combines x y => x -> y -> CombinedType x y
`requires` Machine -> Property UnixLike
File.dirExists Machine
"/etc/flash-kernel"
flashKernel :: Property DebianLike
flashKernel :: Property
(MetaTypes '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
flashKernel = 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
$
Machine -> [Machine] -> UncheckedProperty UnixLike
cmdProperty Machine
"flash-kernel" [] 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 = forall {k} (metatypes :: k).
SingI metatypes =>
Machine
-> Props (MetaTypes metatypes) -> Property (MetaTypes metatypes)
combineProperties Machine
desc forall a b. (a -> b) -> a -> b
$ Props UnixLike
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 Linux
cleanupmounts
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")
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") forall a. Monoid a => a
mempty
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") forall a. Monoid a => a
mempty
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"]
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
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" []
forall (p :: * -> *) i.
Checkable p i =>
p i -> Result -> Property i
`assume` Result
MadeChange
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 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] forall a. [a] -> [a] -> [a]
++ [Machine]
ps)
cleanupmounts :: Property Linux
cleanupmounts :: Property Linux
cleanupmounts = forall {k} (metatypes :: k).
SingI metatypes =>
Machine -> Propellor Result -> Property (MetaTypes metatypes)
property Machine
desc forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Machine -> IO ()
cleanup Machine
"/sys"
Machine -> IO ()
cleanup Machine
"/proc"
Machine -> IO ()
cleanup Machine
"/dev"
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 forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Machine -> IO Bool
isMounted Machine
mp) forall a b. (a -> b) -> a -> b
$
Machine -> IO ()
umountLazy Machine
mp