    -- | Maintainer: Sean Whitton <spwhitton@spwhitton.name>

    module Propellor.Property.Libvirt (
    	NumVCPUs(..),
    	MiBMemory(..),
    	AutoStart(..),
    	DiskImageType(..),
    	installed,
    	defaultNetworkAutostarted,
    	defaultNetworkStarted,
    	defined,
    ) where

    import Propellor.Base
    import Propellor.Types.Info
    import Propellor.Property.Chroot
    import Propellor.Property.DiskImage
    import qualified Propellor.Property.Apt as Apt

    import Utility.Split

    -- | The number of virtual CPUs to assign to the virtual machine
    newtype NumVCPUs = NumVCPUs Int

    -- | The number of MiB of memory to assign to the virtual machine
    newtype MiBMemory = MiBMemory Int

    -- | Whether the virtual machine should be started after it is defined, and at
    -- host system boot
    data AutoStart = AutoStart | NoAutoStart

    -- | Which type of disk image to build for the virtual machine
    data DiskImageType = Raw -- TODO: | QCow2

    -- | Install basic libvirt components
    installed :: Property DebianLike
    installed :: Property DebianLike
    installed = [String] -> Property DebianLike
    Apt.installed [String
    "libvirt-clients", String
    "virtinst", String
    "libvirt-daemon", String
    "libvirt-daemon-system"]

    -- | Ensure that the default libvirt network is set to autostart, and start it.
    --
    -- On Debian, it is not started by default after installation of libvirt.
    defaultNetworkAutostarted :: Property DebianLike
    defaultNetworkAutostarted :: Property DebianLike
    defaultNetworkAutostarted = Property UnixLike
    autostarted
    	Property UnixLike
    -> Property DebianLike
    -> CombinedType (Property UnixLike) (Property DebianLike)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `requires` Property DebianLike
    installed
    	Property DebianLike
    -> Property DebianLike
    -> CombinedType (Property DebianLike) (Property DebianLike)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `before` Property DebianLike
    defaultNetworkStarted
      where
    	autostarted :: Property UnixLike
    autostarted = IO Bool -> UncheckedProperty UnixLike -> Property UnixLike
    forall (p :: * -> *) i (m :: * -> *).
    (Checkable p i, LiftPropellor m) =>
    m Bool -> p i -> Property i
    check (Bool -> Bool
    not (Bool -> Bool) -> IO Bool -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO Bool
    doesFileExist String
    autostartFile) (UncheckedProperty UnixLike -> Property UnixLike)
    -> UncheckedProperty UnixLike -> Property UnixLike
    forall a b. (a -> b) -> a -> b
    $
    		String -> [String] -> UncheckedProperty UnixLike
    cmdProperty String
    "virsh" [String
    "net-autostart", String
    "default"]
    	autostartFile :: String
    autostartFile = String
    "/etc/libvirt/qemu/networks/autostart/default.xml"

    -- | Ensure that the default libvirt network is started.
    defaultNetworkStarted :: Property DebianLike
    defaultNetworkStarted :: Property DebianLike
    defaultNetworkStarted =	Property UnixLike
    go Property UnixLike
    -> Property DebianLike
    -> CombinedType (Property UnixLike) (Property DebianLike)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `requires` Property DebianLike
    installed
      where
    	go :: Property UnixLike
    	go :: Property UnixLike
    go = String -> Propellor Result -> Property UnixLike
    forall {k} (metatypes :: k).
    SingI metatypes =>
    String -> Propellor Result -> Property (MetaTypes metatypes)
    property String
    "start libvirt's default network" (Propellor Result -> Property UnixLike)
    -> Propellor Result -> Property UnixLike
    forall a b. (a -> b) -> a -> b
    $ do
    		[[String]]
    runningNetworks <- IO [[String]] -> Propellor [[String]]
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO [[String]] -> Propellor [[String]])
    -> IO [[String]] -> Propellor [[String]]
    forall a b. (a -> b) -> a -> b
    $ [String] -> IO [[String]]
    virshGetColumns [String
    "net-list"]
    		if [String
    "default"] [String] -> [[String]] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` (Int -> [String] -> [String]
    forall a. Int -> [a] -> [a]
    take Int
    1 ([String] -> [String]) -> [[String]] -> [[String]]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [[String]]
    runningNetworks)
    			then Propellor Result
    noChange
    			else IO () -> Propellor Result
    makeChange (IO () -> Propellor Result) -> IO () -> Propellor Result
    forall a b. (a -> b) -> a -> b
    $ IO Bool -> IO () -> IO ()
    forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
    unlessM IO Bool
    startIt (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
    				String -> IO ()
    forall (m :: * -> *) a. MonadIO m => String -> m a
    errorMessage String
    "failed to start default network"
    	startIt :: IO Bool
    startIt = String -> [CommandParam] -> IO Bool
    boolSystem String
    "virsh" [String -> CommandParam
    Param String
    "net-start", String -> CommandParam
    Param String
    "default"]

    -- | Builds a disk image with the properties of the given Host, installs a
    -- libvirt configuration file to boot the image, and if it is set to autostart,
    -- start the VM.
    --
    -- Note that building the disk image happens only once.  So if you change the
    -- properties of the given Host, this property will not modify the disk image.
    -- In order to later apply properties to the VM, you should spin it directly, or
    -- arrange to have it spun with a property like 'Cron.runPropellor', or use
    -- 'Propellor.Property.Conductor' from the VM host.
    --
    -- Suggested usage in @config.hs@:
    --
    -- > mybox = host "mybox.example.com" $ props
    -- > 	& osDebian (Stable "stretch") X86_64
    -- > 	& Libvirt.defaultNetworkAutostarted
    -- > 	& Libvirt.defined Libvirt.Raw
    -- > 		(Libvirt.MiBMemory 2048) (Libvirt.NumVCPUs 2)
    -- > 		Libvirt.NoAutoStart subbox
    -- >
    -- > subbox = host "subbox.mybox.example.com" $ props
    -- > 	& osDebian Unstable X86_64
    -- > 	& hasPartition
    -- > 		( partition EXT4
    -- > 			`mountedAt` "/"
    -- > 			`addFreeSpace` MegaBytes 10240
    -- > 		)
    -- > 	& Apt.installed ["linux-image-amd64"]
    -- > 	& Grub.installed PC
    -- >
    -- > 	& ipv4 "192.168.122.31"
    -- > 	& Network.static "ens3" (IPv4 "192.168.122.31")
    -- > 		(Just (Network.Gateway (IPv4 "192.168.122.1")))
    -- > 		`requires` Network.cleanInterfacesFile
    -- > 	& Hostname.sane
    defined
    	:: DiskImageType
    	-> MiBMemory
    	-> NumVCPUs
    	-> AutoStart
    	-> Host
    	-> Property (HasInfo + DebianLike)
    defined :: DiskImageType
    -> MiBMemory
    -> NumVCPUs
    -> AutoStart
    -> Host
    -> Property (HasInfo + DebianLike)
    defined DiskImageType
    imageType (MiBMemory Int
    mem) (NumVCPUs Int
    cpus) AutoStart
    auto Host
    h =
    	(Property
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
    Property (HasInfo + DebianLike)
    built Property
      (MetaTypes
         '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish])
    -> Property UnixLike
    -> CombinedType
         (Property
            (MetaTypes
               '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
         (Property UnixLike)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `before` Property UnixLike
    nuked CombinedType
      (Property
         (MetaTypes
            '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
      (Property UnixLike)
    -> Property UnixLike
    -> CombinedType
         (CombinedType
            (Property
               (MetaTypes
                  '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
            (Property UnixLike))
         (Property UnixLike)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `before` Property UnixLike
    xmlDefined CombinedType
      (CombinedType
         (Property
            (MetaTypes
               '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
         (Property UnixLike))
      (Property UnixLike)
    -> Property UnixLike
    -> CombinedType
         (CombinedType
            (CombinedType
               (Property
                  (MetaTypes
                     '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
               (Property UnixLike))
            (Property UnixLike))
         (Property UnixLike)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `before` Property UnixLike
    started)
    	CombinedType
      (CombinedType
         (CombinedType
            (Property
               (MetaTypes
                  '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
            (Property UnixLike))
         (Property UnixLike))
      (Property UnixLike)
    -> Property DebianLike
    -> CombinedType
         (CombinedType
            (CombinedType
               (CombinedType
                  (Property
                     (MetaTypes
                        '[ 'WithInfo, 'Targeting 'OSDebian, 'Targeting 'OSBuntish]))
                  (Property UnixLike))
               (Property UnixLike))
            (Property UnixLike))
         (Property DebianLike)
    forall x y. Combines x y => x -> y -> CombinedType x y
    `requires` Property DebianLike
    installed
      where
    	built :: Property (HasInfo + DebianLike)
    	built :: Property (HasInfo + DebianLike)
    built = IO Bool
    -> Property (HasInfo + DebianLike)
    -> Property (HasInfo + DebianLike)
    forall (p :: * -> *) i (m :: * -> *).
    (Checkable p i, LiftPropellor m) =>
    m Bool -> p i -> Property i
    check (Bool -> Bool
    not (Bool -> Bool) -> IO Bool -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO Bool
    doesFileExist String
    imageLoc) (Property (HasInfo + DebianLike)
     -> Property (HasInfo + DebianLike))
    -> Property (HasInfo + DebianLike)
    -> Property (HasInfo + DebianLike)
    forall a b. (a -> b) -> a -> b
    $
    		RevertableProperty (HasInfo + DebianLike) Linux
    -> Property (HasInfo + DebianLike)
    forall setupmetatypes undometatypes.
    RevertableProperty setupmetatypes undometatypes
    -> Property setupmetatypes
    setupRevertableProperty (RevertableProperty (HasInfo + DebianLike) Linux
     -> Property (HasInfo + DebianLike))
    -> RevertableProperty (HasInfo + DebianLike) Linux
    -> Property (HasInfo + DebianLike)
    forall a b. (a -> b) -> a -> b
    $ Host
    -> RawDiskImage
    -> Debootstrapped
    -> RevertableProperty (HasInfo + DebianLike) Linux
    forall d bootstrapper.
    (DiskImage d, ChrootBootstrapper bootstrapper) =>
    Host
    -> d
    -> bootstrapper
    -> RevertableProperty (HasInfo + DebianLike) Linux
    imageBuiltFor Host
    h
    			(RawDiskImage
    image) (DebootstrapConfig -> Debootstrapped
    Debootstrapped DebootstrapConfig
    forall a. Monoid a => a
    mempty)

    	nuked :: Property UnixLike
    	nuked :: Property UnixLike
    nuked = RawDiskImage -> Property UnixLike
    forall d. DiskImage d => d -> Property UnixLike
    imageChrootNotPresent RawDiskImage
    image

    	xmlDefined :: Property UnixLike
    	xmlDefined :: Property UnixLike
    xmlDefined = IO Bool -> Property UnixLike -> Property UnixLike
    forall (p :: * -> *) i (m :: * -> *).
    (Checkable p i, LiftPropellor m) =>
    m Bool -> p i -> Property i
    check (Bool -> Bool
    not (Bool -> Bool) -> IO Bool -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> IO Bool
    doesFileExist String
    conf) (Property UnixLike -> Property UnixLike)
    -> Property UnixLike -> Property UnixLike
    forall a b. (a -> b) -> a -> b
    $
    		String -> Propellor Result -> Property UnixLike
    forall {k} (metatypes :: k).
    SingI metatypes =>
    String -> Propellor Result -> Property (MetaTypes metatypes)
    property String
    "define the libvirt VM" (Propellor Result -> Property UnixLike)
    -> Propellor Result -> Property UnixLike
    forall a b. (a -> b) -> a -> b
    $
    		String
    -> (String -> Handle -> Propellor Result) -> Propellor Result
    forall (m :: * -> *) a.
    (MonadIO m, MonadMask m) =>
    String -> (String -> Handle -> m a) -> m a
    withTmpFile (Host -> String
    hostName Host
    h) ((String -> Handle -> Propellor Result) -> Propellor Result)
    -> (String -> Handle -> Propellor Result) -> Propellor Result
    forall a b. (a -> b) -> a -> b
    $ \String
    t Handle
    fh -> do
    			String
    xml <- IO String -> Propellor String
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO String -> Propellor String) -> IO String -> Propellor String
    forall a b. (a -> b) -> a -> b
    $ String -> [String] -> IO String
    readProcess String
    "virt-install" ([String] -> IO String) -> [String] -> IO String
    forall a b. (a -> b) -> a -> b
    $
    				[ String
    "-n", Host -> String
    hostName Host
    h
    				, String
    "--memory=" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    mem
    				, String
    "--vcpus=" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Int -> String
    forall a. Show a => a -> String
    show Int
    cpus
    				, String
    "--disk"
    				, String
    "path=" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    imageLoc
    					String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    ",device=disk,bus=virtio"
    				, String
    "--print-xml"
    				] [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    autoStartArg [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++ [String]
    osVariantArg
    			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
    $ Handle -> String -> IO ()
    hPutStrLn Handle
    fh String
    xml
    			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
    $ Handle -> IO ()
    hClose Handle
    fh
    			IO () -> Propellor Result
    makeChange (IO () -> Propellor Result) -> IO () -> Propellor Result
    forall a b. (a -> b) -> a -> b
    $ IO Bool -> IO () -> IO ()
    forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
    unlessM (String -> IO Bool
    defineIt String
    t) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
    				String -> IO ()
    forall (m :: * -> *) a. MonadIO m => String -> m a
    errorMessage String
    "failed to define VM"
    	  where
    		defineIt :: String -> IO Bool
    defineIt String
    t = String -> [CommandParam] -> IO Bool
    boolSystem String
    "virsh" [String -> CommandParam
    Param String
    "define", String -> CommandParam
    Param String
    t]

    	started :: Property UnixLike
    	started :: Property UnixLike
    started = case AutoStart
    auto of
    		AutoStart
    AutoStart -> String -> Propellor Result -> Property UnixLike
    forall {k} (metatypes :: k).
    SingI metatypes =>
    String -> Propellor Result -> Property (MetaTypes metatypes)
    property String
    "start the VM" (Propellor Result -> Property UnixLike)
    -> Propellor Result -> Property UnixLike
    forall a b. (a -> b) -> a -> b
    $ do
    			[[String]]
    runningVMs <- IO [[String]] -> Propellor [[String]]
    forall a. IO a -> Propellor a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO [[String]] -> Propellor [[String]])
    -> IO [[String]] -> Propellor [[String]]
    forall a b. (a -> b) -> a -> b
    $ [String] -> IO [[String]]
    virshGetColumns [String
    "list"]
    			-- From the point of view of `virsh start`, the "State"
    			-- column in the output of `virsh list` is not relevant.
    			-- So long as the VM is listed, it's considered started.
    			if [Host -> String
    hostName Host
    h] [String] -> [[String]] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` (Int -> [String] -> [String]
    forall a. Int -> [a] -> [a]
    take Int
    1 ([String] -> [String])
    -> ([String] -> [String]) -> [String] -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [String] -> [String]
    forall a. Int -> [a] -> [a]
    drop Int
    1 ([String] -> [String]) -> [[String]] -> [[String]]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [[String]]
    runningVMs)
    				then Propellor Result
    noChange
    				else IO () -> Propellor Result
    makeChange (IO () -> Propellor Result) -> IO () -> Propellor Result
    forall a b. (a -> b) -> a -> b
    $ IO Bool -> IO () -> IO ()
    forall {m :: * -> *}. Monad m => m Bool -> m () -> m ()
    unlessM IO Bool
    startIt (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
    					String -> IO ()
    forall (m :: * -> *) a. MonadIO m => String -> m a
    errorMessage String
    "failed to start VM"
    		AutoStart
    NoAutoStart -> Property UnixLike
    forall {k} (t :: k). SingI t => Property (MetaTypes t)
    doNothing
    	  where
    		startIt :: IO Bool
    startIt = String -> [CommandParam] -> IO Bool
    boolSystem String
    "virsh" [String -> CommandParam
    Param String
    "start", String -> CommandParam
    Param (String -> CommandParam) -> String -> CommandParam
    forall a b. (a -> b) -> a -> b
    $ Host -> String
    hostName Host
    h]

    	image :: RawDiskImage
    image = case DiskImageType
    imageType of
    		DiskImageType
    Raw -> String -> RawDiskImage
    RawDiskImage String
    imageLoc
    	imageLoc :: String
    imageLoc =
    		String
    "/var/lib/libvirt/images" String -> String -> String
    </> Host -> String
    hostName Host
    h String -> String -> String
    <.> case DiskImageType
    imageType of
    			DiskImageType
    Raw -> String
    "img"
    	conf :: String
    conf = String
    "/etc/libvirt/qemu" String -> String -> String
    </> Host -> String
    hostName Host
    h String -> String -> String
    <.> String
    "xml"

    	osVariantArg :: [String]
    osVariantArg = [String] -> (String -> [String]) -> Maybe String -> [String]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [] (\String
    v -> [String
    "--os-variant=" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    v]) (Maybe String -> [String]) -> Maybe String -> [String]
    forall a b. (a -> b) -> a -> b
    $ Host -> Maybe String
    osVariant Host
    h
    	autoStartArg :: [String]
    autoStartArg = case AutoStart
    auto of
    		AutoStart
    AutoStart -> [String
    "--autostart"]
    		AutoStart
    NoAutoStart -> []

    -- ==== utility functions ====

    -- The --os-variant property is optional, per virt-install(1), so return Nothing
    -- if there isn't a known correct value.  The VM will still be defined.  Pass
    -- the value if we can, though, to optimise the generated XML for the host's OS
    osVariant :: Host -> Maybe String
    osVariant :: Host -> Maybe String
    osVariant Host
    h = Host -> Maybe System
    hostSystem Host
    h Maybe System -> (System -> Maybe String) -> Maybe String
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \System
    s -> case System
    s of
    	System (Debian DebianKernel
    _ (Stable String
    "jessie")) Architecture
    _ -> String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "debian8"
    	System (Debian DebianKernel
    _ (Stable String
    "stretch")) Architecture
    _ -> String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "debian9"
    	System (Debian DebianKernel
    _ DebianSuite
    Testing) Architecture
    _ -> String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "debiantesting"
    	System (Debian DebianKernel
    _ DebianSuite
    Unstable) Architecture
    _ -> String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "debiantesting"

    	System (Buntish String
    "trusty") Architecture
    _ -> String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "ubuntu14.04"
    	System (Buntish String
    "utopic") Architecture
    _ -> String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "ubuntu14.10"
    	System (Buntish String
    "vivid") Architecture
    _ -> String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "ubuntu15.04"
    	System (Buntish String
    "wily") Architecture
    _ -> String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "ubuntu15.10"
    	System (Buntish String
    "xenial") Architecture
    _ -> String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "ubuntu16.04"
    	System (Buntish String
    "yakkety") Architecture
    _ -> String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "ubuntu16.10"
    	System (Buntish String
    "zesty") Architecture
    _ -> String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "ubuntu17.04"
    	System (Buntish String
    "artful") Architecture
    _ -> String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "ubuntu17.10"
    	System (Buntish String
    "bionic") Architecture
    _ -> String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "ubuntu18.04"

    	System (FreeBSD (FBSDProduction FBSDVersion
    FBSD101)) Architecture
    _ -> String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "freebsd10.1"
    	System (FreeBSD (FBSDProduction FBSDVersion
    FBSD102)) Architecture
    _ -> String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "freebsd10.2"
    	System (FreeBSD (FBSDProduction FBSDVersion
    FBSD093)) Architecture
    _ -> String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "freebsd9.3"
    	System (FreeBSD (FBSDLegacy FBSDVersion
    FBSD101)) Architecture
    _ -> String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "freebsd10.1"
    	System (FreeBSD (FBSDLegacy FBSDVersion
    FBSD102)) Architecture
    _ -> String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "freebsd10.2"
    	System (FreeBSD (FBSDLegacy FBSDVersion
    FBSD093)) Architecture
    _ -> String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "freebsd9.3"

    	-- libvirt doesn't have an archlinux variant yet, it seems
    	System Distribution
    ArchLinux Architecture
    _ -> Maybe String
    forall a. Maybe a
    Nothing

    	-- other stable releases that we don't know about (since there are
    	-- infinitely many possible stable release names, as it is a freeform
    	-- string, we need this to avoid a compiler warning)
    	System (Debian DebianKernel
    _ DebianSuite
    _) Architecture
    _ -> Maybe String
    forall a. Maybe a
    Nothing
    	System (Buntish String
    _) Architecture
    _ -> Maybe String
    forall a. Maybe a
    Nothing

    -- Run a virsh command with the given list of arguments, that is expected to
    -- yield tabular output, and return the rows
    virshGetColumns :: [String] -> IO [[String]]
    virshGetColumns :: [String] -> IO [[String]]
    virshGetColumns [String]
    args = (String -> [String]) -> [String] -> [[String]]
    forall a b. (a -> b) -> [a] -> [b]
    map ((String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null) ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> [String]
    forall a. Eq a => [a] -> [a] -> [[a]]
    split String
    " ") ([String] -> [[String]])
    -> (String -> [String]) -> String -> [[String]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> [String] -> [String]
    forall a. Int -> [a] -> [a]
    drop Int
    2 ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    lines
     	(String -> [[String]]) -> IO String -> IO [[String]]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> [String] -> IO String
    readProcess String
    "virsh" [String]
    args

    hostSystem :: Host -> Maybe System
    hostSystem :: Host -> Maybe System
    hostSystem = InfoVal System -> Maybe System
    forall v. InfoVal v -> Maybe v
    fromInfoVal (InfoVal System -> Maybe System)
    -> (Host -> InfoVal System) -> Host -> Maybe System
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Info -> InfoVal System
    forall v. IsInfo v => Info -> v
    fromInfo (Info -> InfoVal System)
    -> (Host -> Info) -> Host -> InfoVal System
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Host -> Info
    hostInfo