    {-# LANGUAGE TypeOperators, RankNTypes, TypeFamilies, FlexibleContexts #-}

    -- | Installation to a target disk.
    --
    -- Note that the RevertableProperties in this module are not really
    -- revertable; the target disk can't be put back how it was.
    -- The RevertableProperty type is used only to let them  be used
    -- in a Versioned Host as shown below.
    --
    -- Here's an example of a noninteractive installer image using
    -- these properties.
    --
    -- There are two versions of Hosts, the installer and the target system.
    --
    -- > data Variety = Installer | Target
    -- > 	deriving (Eq)
    --
    -- The seed of both the installer and the target. They have some properties
    -- in common, and some different properties. The `targetInstalled`
    -- property knows how to convert the installer it's running on into a
    -- target system.
    --
    -- > seed :: Versioned Variety Host
    -- > seed ver = host "debian.local" $ props
    -- > 	& osDebian Unstable X86_64
    -- > 	& Hostname.sane
    -- >	& Hostname.mailname
    -- > 	& Apt.stdSourcesList
    -- > 	& Apt.installed ["linux-image-amd64"]
    -- > 	& Grub.installed PC
    -- > 	& "en_US.UTF-8" `Locale.selectedFor` ["LANG"]
    -- > 	& ver ( (== Installer) --> targetInstalled seed Target (userInput ver) parts)
    -- > 	& ver ( (== Target)    --> fstabLists (userInput ver) parts)
    -- > 	& ver ( (== Installer) --> targetBootable (userInput ver))
    -- >   where
    -- > 	parts = TargetPartTable MSDOS
    -- > 		[ partition EXT4 `mountedAt` "/"
    -- > 			`useDiskSpace` RemainingSpace
    -- > 		, swapPartition (MegaBytes 1024)
    -- > 		]
    --
    -- The installer disk image can then be built from the seed as follows:
    --
    -- > installerBuilt :: RevertableProperty (HasInfo + DebianLike) Linux
    -- > installerBuilt = imageBuilt (VirtualBoxPointer "/srv/installer.vmdk")
    -- >	(hostChroot (seed `version` installer) (Debootstrapped mempty))
    -- >	MSDOS
    -- > 	 [ partition EXT4 `mountedAt` "/"
    -- >		`setFlag` BootFlag
    -- >		`reservedSpacePercentage` 0
    -- > 		`addFreeSpace` MegaBytes 256
    -- > 	]
    --
    -- When the installer is booted up, and propellor is run, it installs
    -- to the target disk. Since this example is a noninteractive installer,
    -- the details of what it installs to are configured before it's built.
    --
    -- > data HardCodedUserInput = HardCodedUserInput (Maybe TargetDiskDevice) (Maybe DiskEraseConfirmed)
    -- >
    -- > instance UserInput HardCodedUserInput where
    -- > 	targetDiskDevice (HardCodedUserInput t _) = Just t
    -- > 	diskEraseConfirmed (HardCodedUserInput _ c) = Just c
    -- >
    -- > userInput :: Version -> HardCodedUserInput
    -- > userInput Installer =  HardCodedUserInput Nothing Nothing
    -- > userInput Target = HardCodedUserInput (Just (TargetDiskDevice "/dev/sda")) (Just DiskEraseConfirmed)
    --
    -- For an example of how to use this to make an interactive installer,
    -- see <https://git.joeyh.name/index.cgi/secret-project.git/>

    module Propellor.Property.Installer.Target (
    	-- * Main interface
    	TargetPartTable(..),
    	targetInstalled,
    	fstabLists,
    	-- * Additional properties
    	mountTarget,
    	targetBootable,
    	partitionTargetDisk,
    	-- * Utility functions
    	targetDir,
    	probeDisk,
    	findDiskDevices,
    	-- * Installation progress tracking
    	TargetFilled,
    	TargetFilledHandle,
    	prepTargetFilled,
    	checkTargetFilled,
    	TargetFilledPercent(..),
    	targetFilledPercent,
    ) where

    import Propellor
    import Propellor.Property.Installer.Types
    import Propellor.Message
    import Propellor.Types.Bootloader
    import Propellor.Types.PartSpec
    import Propellor.Property.Chroot
    import Propellor.Property.Versioned
    import Propellor.Property.Parted
    import Propellor.Property.Mount
    import qualified Propellor.Property.Fstab as Fstab
    import qualified Propellor.Property.Grub as Grub
    import qualified Propellor.Property.Rsync as Rsync

    import Text.Read
    import Control.Monad
    import Control.Monad.IO.Class (liftIO)
    import System.Directory
    import System.FilePath
    import Data.Maybe
    import Data.List
    import Data.Char
    import Data.Ord
    import Data.Ratio
    import qualified Data.Semigroup as Sem
    import System.Process (readProcess)

    -- | Partition table for the target disk.
    data TargetPartTable = TargetPartTable TableType [PartSpec DiskPart]

    -- | Property that installs the target system to the TargetDiskDevice
    -- specified in the UserInput. That device will be re-partitioned and
    -- formatted and all files erased.
    --
    -- The installation is done efficiently by rsyncing the installer's files
    -- to the target, which forms the basis for a chroot that is provisioned with
    -- the specified version of the Host. Thanks to
    -- Propellor.Property.Versioned, any unwanted properties of the installer
    -- will be automatically reverted in the chroot.
    --
    -- When there is no TargetDiskDevice or the user has not confirmed the
    -- installation, nothing is done except for installing dependencies.
    -- So, this can also be used as a property of the installer
    -- image.
    targetInstalled
    	:: UserInput i
    	=> Versioned v Host
    	-> v
    	-> i
    	-> TargetPartTable
    	-> RevertableProperty (HasInfo + DebianLike) (HasInfo + DebianLike)
    targetInstalled :: forall i v.
    UserInput i =>
    Versioned v Host
    -> v
    -> i
    -> TargetPartTable
    -> RevertableProperty (HasInfo + DebianLike) (HasInfo + DebianLike)
    targetInstalled Versioned v Host
    vtargethost v
    v i
    userinput (TargetPartTable TableType
    tabletype [PartSpec DiskPart]
    partspec) =
    	case (i -> Maybe TargetDiskDevice
    forall i. UserInput i => i -> Maybe TargetDiskDevice
    targetDiskDevice i
    userinput, i -> Maybe DiskEraseConfirmed
    forall i. UserInput i => i -> Maybe DiskEraseConfirmed
    diskEraseConfirmed i
    userinput) of
    		(Just (TargetDiskDevice String
    targetdev), Just DiskEraseConfirmed
    _diskeraseconfirmed) ->
    			RevertableProperty
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
    go RevertableProperty
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
    -> String
    -> RevertableProperty
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
    forall p. IsProp p => p -> String -> p
    `describe` (String
    "target system installed to " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    targetdev)
    		(Maybe TargetDiskDevice, Maybe DiskEraseConfirmed)
    _ -> Property Linux
    -> Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
    forall (untightened :: [MetaType]) (tightened :: [MetaType]).
    (TightenTargetsAllowed untightened tightened, SingI tightened) =>
    Property (MetaTypes untightened) -> Property (MetaTypes tightened)
    forall (p :: * -> *) (untightened :: [MetaType])
           (tightened :: [MetaType]).
    (TightenTargets p, TightenTargetsAllowed untightened tightened,
     SingI tightened) =>
    p (MetaTypes untightened) -> p (MetaTypes tightened)
    tightenTargets Property Linux
    installdeps Property
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
    -> Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
    -> RevertableProperty
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
    forall setupmetatypes undometatypes.
    Property setupmetatypes
    -> Property undometatypes
    -> RevertableProperty setupmetatypes undometatypes
    <!> Property
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
    forall {k} (t :: k). SingI t => Property (MetaTypes t)
    doNothing
      where
    	targethost :: Host
    targethost = Versioned v Host
    vtargethost Versioned v Host -> v -> Host
    forall v t. Versioned v t -> v -> t
    `version` v
    v
    	go :: RevertableProperty
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
    go = Property
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
    -> Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
    -> RevertableProperty
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
    forall setupmetatypes undometatypes.
    Property setupmetatypes
    -> Property undometatypes
    -> RevertableProperty setupmetatypes undometatypes
    RevertableProperty
    		(RevertableProperty
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
      DebianLike
    -> Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
    forall setupmetatypes undometatypes.
    RevertableProperty setupmetatypes undometatypes
    -> Property setupmetatypes
    setupRevertableProperty CombinedType
      (RevertableProperty DebianLike DebianLike)
      (RevertableProperty
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux])
         Linux)
    RevertableProperty
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
      DebianLike
    p)
    		-- Versioned needs both "sides" of the RevertableProperty
    		-- to have the same type, so add empty Info to make the
    		-- types line up.
    		(RevertableProperty
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
      DebianLike
    -> Property DebianLike
    forall setupmetatypes undometatypes.
    RevertableProperty setupmetatypes undometatypes
    -> Property undometatypes
    undoRevertableProperty CombinedType
      (RevertableProperty DebianLike DebianLike)
      (RevertableProperty
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux])
         Linux)
    RevertableProperty
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
      DebianLike
    p 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` Info
    forall a. Monoid a => a
    mempty)
    	  where
    		p :: CombinedType
      (RevertableProperty DebianLike DebianLike)
      (RevertableProperty
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux])
         Linux)
    p = i
    -> TableType
    -> [PartSpec DiskPart]
    -> RevertableProperty DebianLike DebianLike
    forall i.
    UserInput i =>
    i
    -> TableType
    -> [PartSpec DiskPart]
    -> RevertableProperty DebianLike DebianLike
    partitionTargetDisk i
    userinput TableType
    tabletype [PartSpec DiskPart]
    partspec
    			RevertableProperty DebianLike DebianLike
    -> RevertableProperty Linux Linux
    -> CombinedType
         (RevertableProperty DebianLike DebianLike)
         (RevertableProperty Linux Linux)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `before` i -> [PartSpec DiskPart] -> RevertableProperty Linux Linux
    forall i.
    UserInput i =>
    i -> [PartSpec DiskPart] -> RevertableProperty Linux Linux
    mountTarget i
    userinput [PartSpec DiskPart]
    partspec
    			RevertableProperty DebianLike DebianLike
    -> RevertableProperty
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
               'Targeting 'OSArchLinux])
         Linux
    -> CombinedType
         (RevertableProperty DebianLike DebianLike)
         (RevertableProperty
            (MetaTypes
               '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
                  'Targeting 'OSArchLinux])
            Linux)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `before` Chroot -> RevertableProperty (HasInfo + Linux) Linux
    provisioned Chroot
    chroot

    	chroot :: Chroot
    chroot = Host -> RsyncBootstrapper -> String -> Chroot
    forall bootstrapper.
    ChrootBootstrapper bootstrapper =>
    Host -> bootstrapper -> String -> Chroot
    hostChroot Host
    targethost RsyncBootstrapper
    RsyncBootstrapper String
    targetDir

    	-- Install dependencies that will be needed later when installing
    	-- the target.
    	installdeps :: Property (DebianLike + ArchLinux)
    installdeps = Property (DebianLike + ArchLinux)
    Rsync.installed

    data RsyncBootstrapper = RsyncBootstrapper

    instance ChrootBootstrapper RsyncBootstrapper where
    	buildchroot :: RsyncBootstrapper
    -> Info -> String -> Either String (Property Linux)
    buildchroot RsyncBootstrapper
    RsyncBootstrapper Info
    _ String
    target = Property Linux -> Either String (Property Linux)
    forall a b. b -> Either a b
    Right (Property Linux -> Either String (Property Linux))
    -> Property Linux -> Either String (Property Linux)
    forall a b. (a -> b) -> a -> b
    $
    		Property Linux
    mountaside
    			Property Linux
    -> Property Linux -> CombinedType (Property Linux) (Property Linux)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `before` Property Linux
    Property (DebianLike + ArchLinux)
    rsynced
    			CombinedType (Property Linux) (Property Linux)
    -> Property UnixLike
    -> CombinedType
         (CombinedType (Property Linux) (Property Linux))
         (Property UnixLike)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `before` Property UnixLike
    umountaside
    	  where
    	  	-- bind mount the root filesystem to /mnt, which exposes
    		-- the contents of all directories that have things mounted
    		-- on top of them to rsync.
    		mountaside :: Property Linux
    mountaside = String -> String -> Property Linux
    bindMount String
    "/" String
    "/mnt"
    		rsynced :: Property (DebianLike + ArchLinux)
    rsynced = [String] -> Property (DebianLike + ArchLinux)
    Rsync.rsync
    			[ String
    "--one-file-system"
    			, String
    "-aHAXS"
    			, String
    "--delete"
    			, String
    "/mnt/"
    			, String
    target
    			]
    		umountaside :: Property UnixLike
    umountaside = String -> [String] -> UncheckedProperty UnixLike
    cmdProperty String
    "umount" [String
    "-l", String
    "/mnt"]
    			UncheckedProperty UnixLike -> Result -> Property UnixLike
    forall (p :: * -> *) i.
    Checkable p i =>
    p i -> Result -> Property i
    `assume` Result
    MadeChange

    -- | Gets the target mounted.
    mountTarget
    	:: UserInput i
    	=> i
    	-> [PartSpec DiskPart]
    	-> RevertableProperty Linux Linux
    mountTarget :: forall i.
    UserInput i =>
    i -> [PartSpec DiskPart] -> RevertableProperty Linux Linux
    mountTarget i
    userinput [PartSpec DiskPart]
    partspec = Property Linux
    setup Property Linux -> Property Linux -> RevertableProperty Linux Linux
    forall setupmetatypes undometatypes.
    Property setupmetatypes
    -> Property undometatypes
    -> RevertableProperty setupmetatypes undometatypes
    <!> Property Linux
    cleanup
      where
    	setup :: Property Linux
    setup = String -> Propellor Result -> Property Linux
    forall {k} (metatypes :: k).
    SingI metatypes =>
    String -> Propellor Result -> Property (MetaTypes metatypes)
    property String
    "target mounted" (Propellor Result -> Property Linux)
    -> Propellor Result -> Property Linux
    forall a b. (a -> b) -> a -> b
    $
    		case i -> Maybe TargetDiskDevice
    forall i. UserInput i => i -> Maybe TargetDiskDevice
    targetDiskDevice i
    userinput of
    			Just (TargetDiskDevice String
    targetdev) -> do
    				IO () -> Propellor ()
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO ()
    unmountTarget
    				[Bool]
    r <- IO [Bool] -> Propellor [Bool]
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO [Bool] -> Propellor [Bool]) -> IO [Bool] -> Propellor [Bool]
    forall a b. (a -> b) -> a -> b
    $ [((Maybe String, MountOpts), Integer)]
    -> (((Maybe String, MountOpts), Integer) -> IO Bool) -> IO [Bool]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    t a -> (a -> m b) -> m (t b)
    forM [((Maybe String, MountOpts), Integer)]
    tomount ((((Maybe String, MountOpts), Integer) -> IO Bool) -> IO [Bool])
    -> (((Maybe String, MountOpts), Integer) -> IO Bool) -> IO [Bool]
    forall a b. (a -> b) -> a -> b
    $
    					String -> ((Maybe String, MountOpts), Integer) -> IO Bool
    mountone String
    targetdev
    				if [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    and [Bool]
    r
    					then Result -> Propellor Result
    forall a. a -> Propellor a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    MadeChange
    					else Result -> Propellor Result
    forall a. a -> Propellor a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    FailedChange
    			Maybe TargetDiskDevice
    Nothing -> Result -> Propellor Result
    forall a. a -> Propellor a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    NoChange
    	cleanup :: Property Linux
    cleanup = String -> Propellor Result -> Property Linux
    forall {k} (metatypes :: k).
    SingI metatypes =>
    String -> Propellor Result -> Property (MetaTypes metatypes)
    property String
    "target unmounted" (Propellor Result -> Property Linux)
    -> Propellor Result -> Property Linux
    forall a b. (a -> b) -> a -> b
    $ do
    		IO () -> Propellor ()
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO ()
    unmountTarget
    		IO () -> Propellor ()
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Propellor ()) -> IO () -> Propellor ()
    forall a b. (a -> b) -> a -> b
    $ String -> IO ()
    removeDirectoryRecursive String
    targetDir
    		Result -> Propellor Result
    forall a. a -> Propellor a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    NoChange

    	-- Sort so / comes before /home etc
    	tomount :: [((Maybe String, MountOpts), Integer)]
    tomount = (((Maybe String, MountOpts), Integer) -> Maybe String)
    -> [((Maybe String, MountOpts), Integer)]
    -> [((Maybe String, MountOpts), Integer)]
    forall b a. Ord b => (a -> b) -> [a] -> [a]
    sortOn ((Maybe String, MountOpts) -> Maybe String
    forall a b. (a, b) -> a
    fst ((Maybe String, MountOpts) -> Maybe String)
    -> (((Maybe String, MountOpts), Integer)
        -> (Maybe String, MountOpts))
    -> ((Maybe String, MountOpts), Integer)
    -> Maybe String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Maybe String, MountOpts), Integer) -> (Maybe String, MountOpts)
    forall a b. (a, b) -> a
    fst) ([((Maybe String, MountOpts), Integer)]
     -> [((Maybe String, MountOpts), Integer)])
    -> [((Maybe String, MountOpts), Integer)]
    -> [((Maybe String, MountOpts), Integer)]
    forall a b. (a -> b) -> a -> b
    $
    		((PartSpec DiskPart, Integer)
     -> ((Maybe String, MountOpts), Integer))
    -> [(PartSpec DiskPart, Integer)]
    -> [((Maybe String, MountOpts), Integer)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\((Maybe String
    mp, MountOpts
    mo, PartSize -> Partition
    _, DiskPart
    _), Integer
    n) -> ((Maybe String
    mp, MountOpts
    mo), Integer
    n)) ([(PartSpec DiskPart, Integer)]
     -> [((Maybe String, MountOpts), Integer)])
    -> [(PartSpec DiskPart, Integer)]
    -> [((Maybe String, MountOpts), Integer)]
    forall a b. (a -> b) -> a -> b
    $
    		[PartSpec DiskPart] -> [Integer] -> [(PartSpec DiskPart, Integer)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [PartSpec DiskPart]
    partspec [Integer]
    partNums

    	mountone :: String -> ((Maybe String, MountOpts), Integer) -> IO Bool
    mountone String
    targetdev ((Maybe String
    mmountpoint, MountOpts
    mountopts), Integer
    num) =
    		case Maybe String
    mmountpoint of
    			Maybe String
    Nothing -> Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
    			Just String
    mountpoint -> do
    				let targetmount :: String
    targetmount = String
    targetDir String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    mountpoint
    				Bool -> String -> IO ()
    createDirectoryIfMissing Bool
    True String
    targetmount
    				let dev :: String
    dev = String -> Integer -> String
    diskPartition String
    targetdev Integer
    num
    				String -> String -> String -> MountOpts -> IO Bool
    mount String
    "auto" String
    dev String
    targetmount MountOpts
    mountopts

    -- | Property for use in the target Host to set up its fstab.
    -- Should be passed the same TargetPartTable as `targetInstalled`.
    fstabLists
    	:: UserInput i
    	=> i
    	-> TargetPartTable
    	-> RevertableProperty Linux Linux
    fstabLists :: forall i.
    UserInput i =>
    i -> TargetPartTable -> RevertableProperty Linux Linux
    fstabLists i
    userinput (TargetPartTable TableType
    _ [PartSpec DiskPart]
    partspecs) = CombinedType (Property Linux) (Property Linux)
    Property Linux
    setup Property Linux -> Property Linux -> RevertableProperty Linux Linux
    forall setupmetatypes undometatypes.
    Property setupmetatypes
    -> Property undometatypes
    -> RevertableProperty setupmetatypes undometatypes
    <!> Property Linux
    forall {k} (t :: k). SingI t => Property (MetaTypes t)
    doNothing
      where
    	setup :: CombinedType (Property Linux) (Property Linux)
    setup = case i -> Maybe TargetDiskDevice
    forall i. UserInput i => i -> Maybe TargetDiskDevice
    targetDiskDevice i
    userinput of
    		Just (TargetDiskDevice String
    targetdev) ->
    			[String] -> [SwapPartition] -> Property Linux
    Fstab.fstabbed [String]
    mnts (String -> [SwapPartition]
    swaps String
    targetdev)
    				Property Linux
    -> Property Linux -> CombinedType (Property Linux) (Property Linux)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `requires` Property Linux
    devmounted
    				Property Linux
    -> Property Linux -> CombinedType (Property Linux) (Property Linux)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `before` Property Linux
    devumounted
    		Maybe TargetDiskDevice
    Nothing -> CombinedType (Property Linux) (Property Linux)
    Property Linux
    forall {k} (t :: k). SingI t => Property (MetaTypes t)
    doNothing

    	-- needed for ftabbed UUID probing to work
    	devmounted :: Property Linux
    	devmounted :: Property Linux
    devmounted = Property UnixLike -> Property Linux
    forall (untightened :: [MetaType]) (tightened :: [MetaType]).
    (TightenTargetsAllowed untightened tightened, SingI tightened) =>
    Property (MetaTypes untightened) -> Property (MetaTypes tightened)
    forall (p :: * -> *) (untightened :: [MetaType])
           (tightened :: [MetaType]).
    (TightenTargets p, TightenTargetsAllowed untightened tightened,
     SingI tightened) =>
    p (MetaTypes untightened) -> p (MetaTypes tightened)
    tightenTargets (Property UnixLike -> Property Linux)
    -> Property UnixLike -> Property Linux
    forall a b. (a -> b) -> a -> b
    $ String -> String -> String -> MountOpts -> Property UnixLike
    mounted String
    "devtmpfs" String
    "udev" String
    "/dev" MountOpts
    forall a. Monoid a => a
    mempty
    	devumounted :: Property Linux
    	devumounted :: Property Linux
    devumounted = Property UnixLike -> Property Linux
    forall (untightened :: [MetaType]) (tightened :: [MetaType]).
    (TightenTargetsAllowed untightened tightened, SingI tightened) =>
    Property (MetaTypes untightened) -> Property (MetaTypes tightened)
    forall (p :: * -> *) (untightened :: [MetaType])
           (tightened :: [MetaType]).
    (TightenTargets p, TightenTargetsAllowed untightened tightened,
     SingI tightened) =>
    p (MetaTypes untightened) -> p (MetaTypes tightened)
    tightenTargets (Property UnixLike -> Property Linux)
    -> Property UnixLike -> Property Linux
    forall a b. (a -> b) -> a -> b
    $ String -> [String] -> UncheckedProperty UnixLike
    cmdProperty String
    "umount" [String
    "-l", String
    "/dev"]
    		UncheckedProperty UnixLike -> Result -> Property UnixLike
    forall (p :: * -> *) i.
    Checkable p i =>
    p i -> Result -> Property i
    `assume` Result
    MadeChange

    	partitions :: [(Maybe String, Partition)]
    partitions = (PartSpec DiskPart -> (Maybe String, Partition))
    -> [PartSpec DiskPart] -> [(Maybe String, Partition)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(Maybe String
    mp, MountOpts
    _, PartSize -> Partition
    mkpart, DiskPart
    _) -> (Maybe String
    mp, PartSize -> Partition
    mkpart PartSize
    forall a. Monoid a => a
    mempty)) [PartSpec DiskPart]
    partspecs
    	mnts :: [String]
    mnts = ((Maybe String, Partition) -> Maybe String)
    -> [(Maybe String, Partition)] -> [String]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (Maybe String, Partition) -> Maybe String
    forall a b. (a, b) -> a
    fst ([(Maybe String, Partition)] -> [String])
    -> [(Maybe String, Partition)] -> [String]
    forall a b. (a -> b) -> a -> b
    $
    		((Maybe String, Partition) -> Bool)
    -> [(Maybe String, Partition)] -> [(Maybe String, Partition)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\(Maybe String
    _, Partition
    p) -> Partition -> Maybe Fs
    partFs Partition
    p Maybe Fs -> Maybe Fs -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Fs -> Maybe Fs
    forall a. a -> Maybe a
    Just Fs
    LinuxSwap Bool -> Bool -> Bool
    && Partition -> Maybe Fs
    partFs Partition
    p Maybe Fs -> Maybe Fs -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Maybe Fs
    forall a. Maybe a
    Nothing) [(Maybe String, Partition)]
    partitions
    	swaps :: String -> [SwapPartition]
    swaps String
    targetdev =
    		(((Maybe String, Partition), Integer) -> SwapPartition)
    -> [((Maybe String, Partition), Integer)] -> [SwapPartition]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> SwapPartition
    Fstab.SwapPartition (String -> SwapPartition)
    -> (((Maybe String, Partition), Integer) -> String)
    -> ((Maybe String, Partition), Integer)
    -> SwapPartition
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Integer -> String
    diskPartition String
    targetdev (Integer -> String)
    -> (((Maybe String, Partition), Integer) -> Integer)
    -> ((Maybe String, Partition), Integer)
    -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Maybe String, Partition), Integer) -> Integer
    forall a b. (a, b) -> b
    snd) ([((Maybe String, Partition), Integer)] -> [SwapPartition])
    -> [((Maybe String, Partition), Integer)] -> [SwapPartition]
    forall a b. (a -> b) -> a -> b
    $
    			(((Maybe String, Partition), Integer) -> Bool)
    -> [((Maybe String, Partition), Integer)]
    -> [((Maybe String, Partition), Integer)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (\((Maybe String
    _, Partition
    p), Integer
    _) -> Partition -> Maybe Fs
    partFs Partition
    p Maybe Fs -> Maybe Fs -> Bool
    forall a. Eq a => a -> a -> Bool
    == Fs -> Maybe Fs
    forall a. a -> Maybe a
    Just Fs
    LinuxSwap)
    				([(Maybe String, Partition)]
    -> [Integer] -> [((Maybe String, Partition), Integer)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [(Maybe String, Partition)]
    partitions [Integer]
    partNums)

    -- | Make the target bootable using whatever bootloader is installed on it.
    targetBootable
    	:: UserInput i
    	=> i
    	-> RevertableProperty Linux Linux
    targetBootable :: forall i. UserInput i => i -> RevertableProperty Linux Linux
    targetBootable i
    userinput =
    	case (i -> Maybe TargetDiskDevice
    forall i. UserInput i => i -> Maybe TargetDiskDevice
    targetDiskDevice i
    userinput, i -> Maybe DiskEraseConfirmed
    forall i. UserInput i => i -> Maybe DiskEraseConfirmed
    diskEraseConfirmed i
    userinput) of
    		(Just (TargetDiskDevice String
    targetdev), Just DiskEraseConfirmed
    _diskeraseconfirmed) ->
    			String -> Property Linux
    go String
    targetdev Property Linux -> Property Linux -> RevertableProperty Linux Linux
    forall setupmetatypes undometatypes.
    Property setupmetatypes
    -> Property undometatypes
    -> RevertableProperty setupmetatypes undometatypes
    <!> Property Linux
    forall {k} (t :: k). SingI t => Property (MetaTypes t)
    doNothing
    		(Maybe TargetDiskDevice, Maybe DiskEraseConfirmed)
    _ -> Property Linux
    forall {k} (t :: k). SingI t => Property (MetaTypes t)
    doNothing Property Linux -> Property Linux -> RevertableProperty Linux Linux
    forall setupmetatypes undometatypes.
    Property setupmetatypes
    -> Property undometatypes
    -> RevertableProperty setupmetatypes undometatypes
    <!> Property Linux
    forall {k} (t :: k). SingI t => Property (MetaTypes t)
    doNothing
      where
    	desc :: String
    desc = String
    "bootloader installed on target disk"
    	go :: FilePath -> Property Linux
    	go :: String -> Property Linux
    go String
    targetdev = String
    -> (OuterMetaTypesWitness
          '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
             'Targeting 'OSArchLinux]
        -> Propellor Result)
    -> Property Linux
    forall {k} (metatypes :: k).
    SingI metatypes =>
    String
    -> (OuterMetaTypesWitness metatypes -> Propellor Result)
    -> Property (MetaTypes metatypes)
    property' String
    desc ((OuterMetaTypesWitness
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
           'Targeting 'OSArchLinux]
      -> Propellor Result)
     -> Property Linux)
    -> (OuterMetaTypesWitness
          '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
             'Targeting 'OSArchLinux]
        -> Propellor Result)
    -> Property Linux
    forall a b. (a -> b) -> a -> b
    $ \OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux]
    w -> do
    		[BootloaderInstalled]
    bootloaders <- Propellor [BootloaderInstalled]
    forall v. IsInfo v => Propellor v
    askInfo
    		case [BootloaderInstalled]
    bootloaders of
    			[GrubInstalled GrubTarget
    gt] -> OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux]
    -> Property Linux -> Propellor Result
    forall (inner :: [MetaType]) (outer :: [MetaType]).
    EnsurePropertyAllowed inner outer =>
    OuterMetaTypesWitness outer
    -> Property (MetaTypes inner) -> Propellor Result
    ensureProperty OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish,
         'Targeting 'OSArchLinux]
    w (Property Linux -> Propellor Result)
    -> Property Linux -> Propellor Result
    forall a b. (a -> b) -> a -> b
    $
    				String -> String -> GrubTarget -> Property Linux
    Grub.bootsMounted String
    targetDir String
    targetdev GrubTarget
    gt
    			[] -> do
    				String -> Propellor ()
    forall (m :: * -> *). MonadIO m => String -> m ()
    warningMessage String
    "no bootloader was installed"
    				Result -> Propellor Result
    forall a. a -> Propellor a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    NoChange
    			[BootloaderInstalled]
    l -> do
    				String -> Propellor ()
    forall (m :: * -> *). MonadIO m => String -> m ()
    warningMessage (String -> Propellor ()) -> String -> Propellor ()
    forall a b. (a -> b) -> a -> b
    $ String
    "don't know how to enable bootloader(s) " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [BootloaderInstalled] -> String
    forall a. Show a => a -> String
    show [BootloaderInstalled]
    l
    				Result -> Propellor Result
    forall a. a -> Propellor a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Result
    FailedChange

    -- | Partitions the target disk.
    partitionTargetDisk
    	:: UserInput i
    	=> i
    	-> TableType
    	-> [PartSpec DiskPart]
    	-> RevertableProperty DebianLike DebianLike
    partitionTargetDisk :: forall i.
    UserInput i =>
    i
    -> TableType
    -> [PartSpec DiskPart]
    -> RevertableProperty DebianLike DebianLike
    partitionTargetDisk i
    userinput TableType
    tabletype [PartSpec DiskPart]
    partspec = Property DebianLike
    go Property DebianLike
    -> Property DebianLike -> RevertableProperty DebianLike DebianLike
    forall setupmetatypes undometatypes.
    Property setupmetatypes
    -> Property undometatypes
    -> RevertableProperty setupmetatypes undometatypes
    <!> Property DebianLike
    forall {k} (t :: k). SingI t => Property (MetaTypes t)
    doNothing
      where
    	go :: Property DebianLike
    go = IO Bool -> Property DebianLike -> Property DebianLike
    forall (p :: * -> *) i (m :: * -> *).
    (Checkable p i, LiftPropellor m) =>
    m Bool -> p i -> Property i
    check IO Bool
    targetNotMounted (Property DebianLike -> Property DebianLike)
    -> Property DebianLike -> Property DebianLike
    forall a b. (a -> b) -> a -> b
    $ String
    -> (OuterMetaTypesWitness
          '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
        -> Propellor Result)
    -> Property DebianLike
    forall {k} (metatypes :: k).
    SingI metatypes =>
    String
    -> (OuterMetaTypesWitness metatypes -> Propellor Result)
    -> Property (MetaTypes metatypes)
    property' String
    "target disk partitioned" ((OuterMetaTypesWitness
        '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
      -> Propellor Result)
     -> Property DebianLike)
    -> (OuterMetaTypesWitness
          '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
        -> Propellor Result)
    -> Property DebianLike
    forall a b. (a -> b) -> a -> b
    $ \OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    w -> do
    		case (i -> Maybe TargetDiskDevice
    forall i. UserInput i => i -> Maybe TargetDiskDevice
    targetDiskDevice i
    userinput, i -> Maybe DiskEraseConfirmed
    forall i. UserInput i => i -> Maybe DiskEraseConfirmed
    diskEraseConfirmed i
    userinput) of
    			(Just (TargetDiskDevice String
    targetdev), Just DiskEraseConfirmed
    _diskeraseconfirmed) -> do
    				IO () -> Propellor ()
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> Propellor ()) -> IO () -> Propellor ()
    forall a b. (a -> b) -> a -> b
    $ IO ()
    unmountTarget
    				DiskSize
    disksize <- IO DiskSize -> Propellor DiskSize
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO DiskSize -> Propellor DiskSize)
    -> IO DiskSize -> Propellor DiskSize
    forall a b. (a -> b) -> a -> b
    $ String -> IO DiskSize
    getDiskSize String
    targetdev
    				let parttable :: PartTable
    parttable = DiskSize
    -> TableType -> Alignment -> [PartSpec DiskPart] -> PartTable
    calcPartTable DiskSize
    disksize TableType
    tabletype Alignment
    safeAlignment [PartSpec DiskPart]
    partspec
    				OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    -> Property DebianLike -> Propellor Result
    forall (inner :: [MetaType]) (outer :: [MetaType]).
    EnsurePropertyAllowed inner outer =>
    OuterMetaTypesWitness outer
    -> Property (MetaTypes inner) -> Propellor Result
    ensureProperty OuterMetaTypesWitness
      '[ 'Targeting 'OSDebian, 'Targeting 'OSBuntish]
    w (Property DebianLike -> Propellor Result)
    -> Property DebianLike -> Propellor Result
    forall a b. (a -> b) -> a -> b
    $
    					Eep -> String -> PartTable -> Property DebianLike
    partitioned Eep
    YesReallyDeleteDiskContents String
    targetdev PartTable
    parttable
    			(Maybe TargetDiskDevice, Maybe DiskEraseConfirmed)
    _ -> String -> Propellor Result
    forall a. HasCallStack => String -> a
    error String
    "user input does not allow partitioning disk"

    unmountTarget :: IO ()
    unmountTarget :: IO ()
    unmountTarget = (String -> IO ()) -> [String] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ String -> IO ()
    umountLazy ([String] -> IO ()) -> ([String] -> [String]) -> [String] -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> [String]
    forall a. [a] -> [a]
    reverse ([String] -> [String])
    -> ([String] -> [String]) -> [String] -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> [String]
    forall a. Ord a => [a] -> [a]
    sort ([String] -> IO ()) -> IO [String] -> IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< IO [String]
    targetMountPoints

    targetMountPoints :: IO [MountPoint]
    targetMountPoints :: IO [String]
    targetMountPoints = (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter String -> Bool
    isTargetMountPoint ([String] -> [String]) -> IO [String] -> IO [String]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO [String]
    mountPoints

    isTargetMountPoint :: MountPoint -> Bool
    isTargetMountPoint :: String -> Bool
    isTargetMountPoint String
    mp =
    	String
    mp String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    targetDir
    		Bool -> Bool -> Bool
    || String -> String
    addTrailingPathSeparator String
    targetDir String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    mp

    targetNotMounted :: IO Bool
    targetNotMounted :: IO Bool
    targetNotMounted = Bool -> Bool
    not (Bool -> Bool) -> ([String] -> Bool) -> [String] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> Bool) -> [String] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    targetDir) ([String] -> Bool) -> IO [String] -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO [String]
    mountPoints

    -- | Where the target disk is mounted while it's being installed.
    targetDir :: FilePath
    targetDir :: String
    targetDir = String
    "/target"

    partNums :: [Integer]
    partNums :: [Integer]
    partNums = [Integer
    1..]

    -- /dev/sda to /dev/sda1
    diskPartition :: FilePath -> Integer -> FilePath
    diskPartition :: String -> Integer -> String
    diskPartition String
    dev Integer
    num = String
    dev String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Integer -> String
    forall a. Show a => a -> String
    show Integer
    num

    -- | This can be used to find a likely disk device to use as the target
    -- for an installation.
    --
    -- This is a bit of a hack; of course the user could be prompted but to
    -- avoid prompting, some heuristics...
    --   * It should not already be mounted.
    --   * Prefer disks big enough to comfortably hold a Linux installation,
    --     so at least 8 gb.
    --     (But, if the system only has a smaller disk, it should be used.)
    --   * A medium size internal disk is better than a large removable disk,
    --     because removable or added drives are often used for data storage
    --     on systems with smaller internal disk for the OS.
    --     (But, if the internal disk is too small, prefer removable disk;
    --     some systems have an unusably small internal disk.)
    --   * Prefer the first disk in BIOS order, all other things being equal,
    --     because the main OS disk typically comes first. This can be
    --     approximated by preferring /dev/sda to /dev/sdb.
    probeDisk :: IO TargetDiskDevice
    probeDisk :: IO TargetDiskDevice
    probeDisk = do
    	IO ()
    unmountTarget
    	[MinorNumber]
    mounteddevs <- IO [MinorNumber]
    getMountedDeviceIDs
    	let notmounted :: String -> IO Bool
    notmounted String
    d = (Maybe MinorNumber -> [Maybe MinorNumber] -> Bool)
    -> [Maybe MinorNumber] -> Maybe MinorNumber -> Bool
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Maybe MinorNumber -> [Maybe MinorNumber] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    notElem ((MinorNumber -> Maybe MinorNumber)
    -> [MinorNumber] -> [Maybe MinorNumber]
    forall a b. (a -> b) -> [a] -> [b]
    map MinorNumber -> Maybe MinorNumber
    forall a. a -> Maybe a
    Just [MinorNumber]
    mounteddevs)
    		(Maybe MinorNumber -> Bool) -> IO (Maybe MinorNumber) -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO (Maybe MinorNumber)
    getMinorNumber String
    d
    	[Candidate]
    candidates <- (String -> IO Candidate) -> [String] -> IO [Candidate]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM String -> IO Candidate
    probeCandidate
    		([String] -> IO [Candidate]) -> IO [String] -> IO [Candidate]
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< (String -> IO Bool) -> [String] -> IO [String]
    forall (m :: * -> *) a.
    Applicative m =>
    (a -> m Bool) -> [a] -> m [a]
    filterM String -> IO Bool
    notmounted
    		([String] -> IO [String]) -> IO [String] -> IO [String]
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< IO [String]
    findDiskDevices
    	case [Candidate] -> [Candidate]
    forall a. [a] -> [a]
    reverse ([Candidate] -> [Candidate]
    forall a. Ord a => [a] -> [a]
    sort [Candidate]
    candidates) of
    		(Candidate { candidateDevice :: Candidate -> Down String
    candidateDevice = Down String
    dev } : [Candidate]
    _) ->
    			TargetDiskDevice -> IO TargetDiskDevice
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TargetDiskDevice -> IO TargetDiskDevice)
    -> TargetDiskDevice -> IO TargetDiskDevice
    forall a b. (a -> b) -> a -> b
    $ String -> TargetDiskDevice
    TargetDiskDevice String
    dev
    		[] -> String -> IO TargetDiskDevice
    forall a. HasCallStack => String -> a
    error String
    "Unable to find any disk to install to!"

    -- | Find disk devices, such as /dev/sda (not partitions)
    findDiskDevices :: IO [FilePath]
    findDiskDevices :: IO [String]
    findDiskDevices = (String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map (String
    "/dev" String -> String -> String
    </>) ([String] -> [String])
    -> ([String] -> [String]) -> [String] -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter String -> Bool
    isdisk
    	([String] -> [String]) -> IO [String] -> IO [String]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO [String]
    getDirectoryContents String
    "/dev"
      where
    	isdisk :: String -> Bool
    isdisk (Char
    's':Char
    'd':Char
    _:[]) = Bool
    True
    	isdisk String
    _ = Bool
    False

    -- | When comparing two Candidates, the better of the two will be larger.
    data Candidate = Candidate
    	{ Candidate -> Bool
    candidateBigEnoughForOS :: Bool
    	, Candidate -> Bool
    candidateIsFixedDisk :: Bool
    	-- use Down so that /dev/sda orders larger than /dev/sdb
    	, Candidate -> Down String
    candidateDevice :: Down FilePath
    	} deriving (Candidate -> Candidate -> Bool
    (Candidate -> Candidate -> Bool)
    -> (Candidate -> Candidate -> Bool) -> Eq Candidate
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Candidate -> Candidate -> Bool
    == :: Candidate -> Candidate -> Bool
    $c/= :: Candidate -> Candidate -> Bool
    /= :: Candidate -> Candidate -> Bool
    Eq, Eq Candidate
    Eq Candidate
    -> (Candidate -> Candidate -> Ordering)
    -> (Candidate -> Candidate -> Bool)
    -> (Candidate -> Candidate -> Bool)
    -> (Candidate -> Candidate -> Bool)
    -> (Candidate -> Candidate -> Bool)
    -> (Candidate -> Candidate -> Candidate)
    -> (Candidate -> Candidate -> Candidate)
    -> Ord Candidate
    Candidate -> Candidate -> Bool
    Candidate -> Candidate -> Ordering
    Candidate -> Candidate -> Candidate
    forall a.
    Eq a
    -> (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: Candidate -> Candidate -> Ordering
    compare :: Candidate -> Candidate -> Ordering
    $c< :: Candidate -> Candidate -> Bool
    < :: Candidate -> Candidate -> Bool
    $c<= :: Candidate -> Candidate -> Bool
    <= :: Candidate -> Candidate -> Bool
    $c> :: Candidate -> Candidate -> Bool
    > :: Candidate -> Candidate -> Bool
    $c>= :: Candidate -> Candidate -> Bool
    >= :: Candidate -> Candidate -> Bool
    $cmax :: Candidate -> Candidate -> Candidate
    max :: Candidate -> Candidate -> Candidate
    $cmin :: Candidate -> Candidate -> Candidate
    min :: Candidate -> Candidate -> Candidate
    Ord)

    probeCandidate :: FilePath -> IO Candidate
    probeCandidate :: String -> IO Candidate
    probeCandidate String
    dev = do
    	DiskSize Integer
    sz <- String -> IO DiskSize
    getDiskSize String
    dev
    	Bool
    isfixeddisk <- Bool -> Bool
    not (Bool -> Bool) -> IO Bool -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO Bool
    isRemovableDisk String
    dev
    	Candidate -> IO Candidate
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Candidate -> IO Candidate) -> Candidate -> IO Candidate
    forall a b. (a -> b) -> a -> b
    $ Candidate
    		{ candidateBigEnoughForOS :: Bool
    candidateBigEnoughForOS = Integer
    sz Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Integer
    8 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * Integer
    onegb
    		, candidateIsFixedDisk :: Bool
    candidateIsFixedDisk = Bool
    isfixeddisk
    		, candidateDevice :: Down String
    candidateDevice = String -> Down String
    forall a. a -> Down a
    Down String
    dev
    		}
      where
    	onegb :: Integer
    onegb = Integer
    1024Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    *Integer
    1024Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    *Integer
    1000

    newtype MinorNumber = MinorNumber Integer
    	deriving (MinorNumber -> MinorNumber -> Bool
    (MinorNumber -> MinorNumber -> Bool)
    -> (MinorNumber -> MinorNumber -> Bool) -> Eq MinorNumber
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: MinorNumber -> MinorNumber -> Bool
    == :: MinorNumber -> MinorNumber -> Bool
    $c/= :: MinorNumber -> MinorNumber -> Bool
    /= :: MinorNumber -> MinorNumber -> Bool
    Eq, Int -> MinorNumber -> String -> String
    [MinorNumber] -> String -> String
    MinorNumber -> String
    (Int -> MinorNumber -> String -> String)
    -> (MinorNumber -> String)
    -> ([MinorNumber] -> String -> String)
    -> Show MinorNumber
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> MinorNumber -> String -> String
    showsPrec :: Int -> MinorNumber -> String -> String
    $cshow :: MinorNumber -> String
    show :: MinorNumber -> String
    $cshowList :: [MinorNumber] -> String -> String
    showList :: [MinorNumber] -> String -> String
    Show)

    getMountedDeviceIDs :: IO [MinorNumber]
    getMountedDeviceIDs :: IO [MinorNumber]
    getMountedDeviceIDs = (String -> Maybe MinorNumber) -> [String] -> [MinorNumber]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe String -> Maybe MinorNumber
    parse ([String] -> [MinorNumber])
    -> (String -> [String]) -> String -> [MinorNumber]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    lines (String -> [MinorNumber]) -> IO String -> IO [MinorNumber]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> [String] -> String -> IO String
    readProcess String
    "findmnt"
    	[ String
    "-rn"
    	, String
    "--output"
    	, String
    "MAJ:MIN"
    	]
    	String
    ""
      where
    	parse :: String -> Maybe MinorNumber
    parse = (Integer -> MinorNumber) -> Maybe Integer -> Maybe MinorNumber
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Integer -> MinorNumber
    MinorNumber (Maybe Integer -> Maybe MinorNumber)
    -> (String -> Maybe Integer) -> String -> Maybe MinorNumber
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Maybe Integer
    forall a. Read a => String -> Maybe a
    readMaybe
    		(String -> Maybe Integer)
    -> (String -> String) -> String -> Maybe Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Bool -> Bool
    not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Char -> Bool
    isDigit) (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    ':')

    -- There is not currently a native haskell interface for getting the minor
    -- number of a device.
    getMinorNumber :: FilePath -> IO (Maybe MinorNumber)
    getMinorNumber :: String -> IO (Maybe MinorNumber)
    getMinorNumber String
    dev = (Integer -> MinorNumber) -> Maybe Integer -> Maybe MinorNumber
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Integer -> MinorNumber
    MinorNumber (Maybe Integer -> Maybe MinorNumber)
    -> (String -> Maybe Integer) -> String -> Maybe MinorNumber
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Maybe Integer
    forall a. Read a => String -> Maybe a
    readMaybe
    	(String -> Maybe MinorNumber)
    -> IO String -> IO (Maybe MinorNumber)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> [String] -> String -> IO String
    readProcess String
    "stat" [ String
    "--printf", String
    "%T", String
    dev ] String
    ""

    -- A removable disk may show up as removable or as hotplug.
    isRemovableDisk :: FilePath -> IO Bool
    isRemovableDisk :: String -> IO Bool
    isRemovableDisk String
    dev = do
    	Bool
    isremovable <- String -> IO Bool
    checkblk String
    "RM"
    	Bool
    ishotplug <- String -> IO Bool
    checkblk String
    "HOTPLUG"
    	Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Bool
    isremovable Bool -> Bool -> Bool
    || Bool
    ishotplug)
      where
    	checkblk :: String -> IO Bool
    checkblk String
    field = (String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "1\n") (String -> Bool) -> IO String -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> [String] -> String -> IO String
    readProcess String
    "lsblk"
    		[ String
    "-rn"
    		, String
    "--nodeps"
    		, String
    "--output", String
    field
    		, String
    dev
    		]
    		String
    ""

    getDiskSize :: FilePath -> IO DiskSize
    getDiskSize :: String -> IO DiskSize
    getDiskSize String
    dev = do
    	Integer
    sectors <- Integer -> Maybe Integer -> Integer
    forall a. a -> Maybe a -> a
    fromMaybe Integer
    0 (Maybe Integer -> Integer)
    -> (String -> Maybe Integer) -> String -> Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Maybe Integer
    forall a. Read a => String -> Maybe a
    readMaybe
    		(String -> Integer) -> IO String -> IO Integer
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> [String] -> String -> IO String
    readProcess String
    "blockdev" [String
    "--getsz", String
    dev] String
    ""
    	DiskSize -> IO DiskSize
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> DiskSize
    DiskSize (Integer
    sectors Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * Integer
    512))

    getMountsSizes :: IO [(MountPoint, Integer)]
    getMountsSizes :: IO [(String, Integer)]
    getMountsSizes = (String -> Maybe (String, Integer))
    -> [String] -> [(String, Integer)]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe ([String] -> Maybe (String, Integer)
    forall {b}. Read b => [String] -> Maybe (String, b)
    parse ([String] -> Maybe (String, Integer))
    -> (String -> [String]) -> String -> Maybe (String, Integer)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    words) ([String] -> [(String, Integer)])
    -> (String -> [String]) -> String -> [(String, Integer)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    lines (String -> [(String, Integer)])
    -> IO String -> IO [(String, Integer)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> [String] -> String -> IO String
    readProcess String
    "findmnt" [String]
    ps String
    ""
      where
    	ps :: [String]
    ps = [String
    "-rnb", String
    "-o", String
    "TARGET,USED"]
    	parse :: [String] -> Maybe (String, b)
    parse (String
    mp:String
    szs:[]) = do
    		b
    sz <- String -> Maybe b
    forall a. Read a => String -> Maybe a
    readMaybe String
    szs
    		(String, b) -> Maybe (String, b)
    forall a. a -> Maybe a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (String
    mp, b
    sz)
    	parse [String]
    _ = Maybe (String, b)
    forall a. Maybe a
    Nothing

    -- | How much of the target disks are used, compared with the size of the
    -- installer's root device. Since the main part of an installation
    -- is `targetInstalled` rsyncing the latter to the former, this allows
    -- roughly estimating the percent done while an install is running,
    -- and can be used in some sort of progress display.
    data TargetFilled = TargetFilled (Ratio Integer)
    	deriving (Int -> TargetFilled -> String -> String
    [TargetFilled] -> String -> String
    TargetFilled -> String
    (Int -> TargetFilled -> String -> String)
    -> (TargetFilled -> String)
    -> ([TargetFilled] -> String -> String)
    -> Show TargetFilled
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> TargetFilled -> String -> String
    showsPrec :: Int -> TargetFilled -> String -> String
    $cshow :: TargetFilled -> String
    show :: TargetFilled -> String
    $cshowList :: [TargetFilled] -> String -> String
    showList :: [TargetFilled] -> String -> String
    Show, TargetFilled -> TargetFilled -> Bool
    (TargetFilled -> TargetFilled -> Bool)
    -> (TargetFilled -> TargetFilled -> Bool) -> Eq TargetFilled
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: TargetFilled -> TargetFilled -> Bool
    == :: TargetFilled -> TargetFilled -> Bool
    $c/= :: TargetFilled -> TargetFilled -> Bool
    /= :: TargetFilled -> TargetFilled -> Bool
    Eq)

    instance Sem.Semigroup TargetFilled where
    	TargetFilled Ratio Integer
    n <> :: TargetFilled -> TargetFilled -> TargetFilled
    <> TargetFilled Ratio Integer
    m = Ratio Integer -> TargetFilled
    TargetFilled (Ratio Integer
    nRatio Integer -> Ratio Integer -> Ratio Integer
    forall a. Num a => a -> a -> a
    +Ratio Integer
    m)

    instance Monoid TargetFilled where
    	mempty :: TargetFilled
    mempty = Ratio Integer -> TargetFilled
    TargetFilled (Integer
    0 Integer -> Integer -> Ratio Integer
    forall a. Integral a => a -> a -> Ratio a
    % Integer
    1)
    	mappend :: TargetFilled -> TargetFilled -> TargetFilled
    mappend = TargetFilled -> TargetFilled -> TargetFilled
    forall a. Semigroup a => a -> a -> a
    (Sem.<>)

    newtype TargetFilledHandle = TargetFilledHandle Integer

    -- | Prepare for getting `TargetFilled`.
    prepTargetFilled :: IO TargetFilledHandle
    prepTargetFilled :: IO TargetFilledHandle
    prepTargetFilled = Maybe String -> IO TargetFilledHandle
    go (Maybe String -> IO TargetFilledHandle)
    -> IO (Maybe String) -> IO TargetFilledHandle
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< String -> IO (Maybe String)
    getMountSource String
    "/"
      where
    	go :: Maybe String -> IO TargetFilledHandle
    go (Just String
    dev) = do
    		-- Assumes that the installer uses a single partition.
    		DiskSize Integer
    sz <- String -> IO DiskSize
    getDiskSize String
    dev
    		TargetFilledHandle -> IO TargetFilledHandle
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> TargetFilledHandle
    TargetFilledHandle Integer
    sz)
    	go Maybe String
    Nothing = TargetFilledHandle -> IO TargetFilledHandle
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> TargetFilledHandle
    TargetFilledHandle Integer
    0)

    -- | Get the current `TargetFilled` value. This is fast enough to be run
    -- multiple times per second without using much CPU.
    checkTargetFilled :: TargetFilledHandle -> IO TargetFilled
    checkTargetFilled :: TargetFilledHandle -> IO TargetFilled
    checkTargetFilled (TargetFilledHandle Integer
    installsz) = do
    	Integer
    targetsz <- [Integer] -> Integer
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ([Integer] -> Integer)
    -> ([(String, Integer)] -> [Integer])
    -> [(String, Integer)]
    -> Integer
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((String, Integer) -> Integer) -> [(String, Integer)] -> [Integer]
    forall a b. (a -> b) -> [a] -> [b]
    map (String, Integer) -> Integer
    forall a b. (a, b) -> b
    snd ([(String, Integer)] -> [Integer])
    -> ([(String, Integer)] -> [(String, Integer)])
    -> [(String, Integer)]
    -> [Integer]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((String, Integer) -> Bool)
    -> [(String, Integer)] -> [(String, Integer)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (String -> Bool
    isTargetMountPoint (String -> Bool)
    -> ((String, Integer) -> String) -> (String, Integer) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String, Integer) -> String
    forall a b. (a, b) -> a
    fst)
    		([(String, Integer)] -> Integer)
    -> IO [(String, Integer)] -> IO Integer
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO [(String, Integer)]
    getMountsSizes
    	TargetFilled -> IO TargetFilled
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Ratio Integer -> TargetFilled
    TargetFilled (Integer
    targetsz Integer -> Integer -> Ratio Integer
    forall a. Integral a => a -> a -> Ratio a
    % Integer -> Integer -> Integer
    forall a. Ord a => a -> a -> a
    max Integer
    1 Integer
    installsz))

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

    targetFilledPercent :: TargetFilled -> TargetFilledPercent
    targetFilledPercent :: TargetFilled -> TargetFilledPercent
    targetFilledPercent (TargetFilled Ratio Integer
    r) = Int -> TargetFilledPercent
    TargetFilledPercent (Int -> TargetFilledPercent) -> Int -> TargetFilledPercent
    forall a b. (a -> b) -> a -> b
    $ Double -> Int
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    floor Double
    percent
      where
    	percent :: Double
    	percent :: Double
    percent = Double -> Double -> Double
    forall a. Ord a => a -> a -> a
    min Double
    100 (Ratio Integer -> Double
    forall a. Fractional a => Ratio Integer -> a
    fromRational Ratio Integer
    r Double -> Double -> Double
    forall a. Num a => a -> a -> a
    * Double
    100)