    -- | Make ARM systems bootable using Debian's flash-kernel package.

    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

    -- | A machine name, such as "Cubietech Cubietruck" or "Olimex A10-OLinuXino-LIME"
    --
    -- flash-kernel supports many different machines,
    -- see its file /usr/share/flash-kernel/db/all.db for a list.
    type Machine = String

    -- | Uses flash-kernel to make a machine bootable.
    --
    -- Before using this, an appropriate kernel needs to already be installed,
    -- and on many machines, u-boot needs to be installed too.
    installed :: Machine -> Property (HasInfo + DebianLike)
    installed :: Machine -> Property (HasInfo + DebianLike)
    installed machine :: 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 = "/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 "/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 ["flash-kernel"]

    -- | Runs flash-kernel with whatever machine `installed` configured.
    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 "flash-kernel" [] UncheckedProperty UnixLike -> Result -> Property UnixLike
    forall (p :: * -> *) i.
    Checkable p i =>
    p i -> Result -> Property i
    `assume` Result
    MadeChange

    -- | Runs flash-kernel in the system mounted at a particular directory.
    flashKernelMounted :: FilePath -> Property Linux
    flashKernelMounted :: Machine -> Property Linux
    flashKernelMounted mnt :: 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
    	-- remove mounts that are done below to make sure the right thing
    	-- gets mounted
    	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 "/dev" (Machine -> Machine
    inmnt "/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 "proc" "proc" (Machine -> Machine
    inmnt "/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 "sysfs" "sys" (Machine -> Machine
    inmnt "/sys") MountOpts
    forall a. Monoid a => a
    mempty
    	-- update the initramfs so it gets the uuid of the root partition
    	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 "update-initramfs" ["-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 "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 = "flash-kernel run"

    	-- cannot use </> since the filepath is absolute
    	inmnt :: Machine -> Machine
    inmnt f :: Machine
    f = Machine
    mnt Machine -> Machine -> Machine
    forall a. [a] -> [a] -> [a]
    ++ Machine
    f

    	inchroot :: Machine -> [Machine] -> UncheckedProperty UnixLike
    inchroot cmd :: Machine
    cmd ps :: [Machine]
    ps = Machine -> [Machine] -> UncheckedProperty UnixLike
    cmdProperty "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 "/sys"
    		Machine -> IO ()
    cleanup "/proc"
    		Machine -> IO ()
    cleanup "/dev"
    		Result -> IO Result
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    NoChange
    	  where
    		cleanup :: Machine -> IO ()
    cleanup m :: 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