-- | 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