module B9.B9Config.LibVirtLXC
  ( libVirtLXCConfigToCPDocument,
    defaultLibVirtLXCConfig,
    parseLibVirtLXCConfig,
    LibVirtLXCConfig (..),
    networkId,
    getEmulatorPath,
  )
where

import B9.B9Config.Container
import B9.DiskImages
import B9.ExecEnv
import Control.Lens (makeLenses)
import Control.Monad.IO.Class
import Data.ConfigFile.B9Extras
import Data.Maybe (fromMaybe)
import System.Environment.Blank as SysIO
import Test.QuickCheck (Arbitrary(arbitrary),oneof,listOf1)
import B9.QCUtil (smaller, arbitraryFilePath, arbitraryLetter)

data LibVirtLXCConfig
  = LibVirtLXCConfig
      { LibVirtLXCConfig -> Bool
useSudo :: Bool,
        LibVirtLXCConfig -> Maybe FilePath
emulator :: Maybe FilePath,
        LibVirtLXCConfig -> FilePath
virshURI :: FilePath,
        LibVirtLXCConfig -> Maybe FilePath
_networkId :: Maybe String,
        LibVirtLXCConfig -> [ContainerCapability]
guestCapabilities :: [ContainerCapability],
        LibVirtLXCConfig -> RamSize
guestRamSize :: RamSize,
        LibVirtLXCConfig -> Maybe FilePath
imageFileNameShortenerBasePath :: Maybe FilePath
      }
  deriving (ReadPrec [LibVirtLXCConfig]
ReadPrec LibVirtLXCConfig
Int -> ReadS LibVirtLXCConfig
ReadS [LibVirtLXCConfig]
(Int -> ReadS LibVirtLXCConfig)
-> ReadS [LibVirtLXCConfig]
-> ReadPrec LibVirtLXCConfig
-> ReadPrec [LibVirtLXCConfig]
-> Read LibVirtLXCConfig
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LibVirtLXCConfig]
$creadListPrec :: ReadPrec [LibVirtLXCConfig]
readPrec :: ReadPrec LibVirtLXCConfig
$creadPrec :: ReadPrec LibVirtLXCConfig
readList :: ReadS [LibVirtLXCConfig]
$creadList :: ReadS [LibVirtLXCConfig]
readsPrec :: Int -> ReadS LibVirtLXCConfig
$creadsPrec :: Int -> ReadS LibVirtLXCConfig
Read, Int -> LibVirtLXCConfig -> ShowS
[LibVirtLXCConfig] -> ShowS
LibVirtLXCConfig -> FilePath
(Int -> LibVirtLXCConfig -> ShowS)
-> (LibVirtLXCConfig -> FilePath)
-> ([LibVirtLXCConfig] -> ShowS)
-> Show LibVirtLXCConfig
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [LibVirtLXCConfig] -> ShowS
$cshowList :: [LibVirtLXCConfig] -> ShowS
show :: LibVirtLXCConfig -> FilePath
$cshow :: LibVirtLXCConfig -> FilePath
showsPrec :: Int -> LibVirtLXCConfig -> ShowS
$cshowsPrec :: Int -> LibVirtLXCConfig -> ShowS
Show, LibVirtLXCConfig -> LibVirtLXCConfig -> Bool
(LibVirtLXCConfig -> LibVirtLXCConfig -> Bool)
-> (LibVirtLXCConfig -> LibVirtLXCConfig -> Bool)
-> Eq LibVirtLXCConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LibVirtLXCConfig -> LibVirtLXCConfig -> Bool
$c/= :: LibVirtLXCConfig -> LibVirtLXCConfig -> Bool
== :: LibVirtLXCConfig -> LibVirtLXCConfig -> Bool
$c== :: LibVirtLXCConfig -> LibVirtLXCConfig -> Bool
Eq)

instance Arbitrary LibVirtLXCConfig where
  arbitrary :: Gen LibVirtLXCConfig
arbitrary = 
    Bool
-> Maybe FilePath
-> FilePath
-> Maybe FilePath
-> [ContainerCapability]
-> RamSize
-> Maybe FilePath
-> LibVirtLXCConfig
LibVirtLXCConfig (Bool
 -> Maybe FilePath
 -> FilePath
 -> Maybe FilePath
 -> [ContainerCapability]
 -> RamSize
 -> Maybe FilePath
 -> LibVirtLXCConfig)
-> Gen Bool
-> Gen
     (Maybe FilePath
      -> FilePath
      -> Maybe FilePath
      -> [ContainerCapability]
      -> RamSize
      -> Maybe FilePath
      -> LibVirtLXCConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    Gen Bool -> Gen Bool
forall a. Gen a -> Gen a
smaller Gen Bool
forall a. Arbitrary a => Gen a
arbitrary Gen
  (Maybe FilePath
   -> FilePath
   -> Maybe FilePath
   -> [ContainerCapability]
   -> RamSize
   -> Maybe FilePath
   -> LibVirtLXCConfig)
-> Gen (Maybe FilePath)
-> Gen
     (FilePath
      -> Maybe FilePath
      -> [ContainerCapability]
      -> RamSize
      -> Maybe FilePath
      -> LibVirtLXCConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Gen (Maybe FilePath) -> Gen (Maybe FilePath)
forall a. Gen a -> Gen a
smaller ([Gen (Maybe FilePath)] -> Gen (Maybe FilePath)
forall a. [Gen a] -> Gen a
oneof [Maybe FilePath -> Gen (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing, FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath)
-> Gen FilePath -> Gen (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen FilePath
arbitraryFilePath]) Gen
  (FilePath
   -> Maybe FilePath
   -> [ContainerCapability]
   -> RamSize
   -> Maybe FilePath
   -> LibVirtLXCConfig)
-> Gen FilePath
-> Gen
     (Maybe FilePath
      -> [ContainerCapability]
      -> RamSize
      -> Maybe FilePath
      -> LibVirtLXCConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Gen FilePath -> Gen FilePath
forall a. Gen a -> Gen a
smaller Gen FilePath
arbitraryFilePath Gen
  (Maybe FilePath
   -> [ContainerCapability]
   -> RamSize
   -> Maybe FilePath
   -> LibVirtLXCConfig)
-> Gen (Maybe FilePath)
-> Gen
     ([ContainerCapability]
      -> RamSize -> Maybe FilePath -> LibVirtLXCConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Gen (Maybe FilePath) -> Gen (Maybe FilePath)
forall a. Gen a -> Gen a
smaller ([Gen (Maybe FilePath)] -> Gen (Maybe FilePath)
forall a. [Gen a] -> Gen a
oneof [Maybe FilePath -> Gen (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing, FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath)
-> Gen FilePath -> Gen (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Char -> Gen FilePath
forall a. Gen a -> Gen [a]
listOf1 Gen Char
arbitraryLetter]) Gen
  ([ContainerCapability]
   -> RamSize -> Maybe FilePath -> LibVirtLXCConfig)
-> Gen [ContainerCapability]
-> Gen (RamSize -> Maybe FilePath -> LibVirtLXCConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Gen [ContainerCapability] -> Gen [ContainerCapability]
forall a. Gen a -> Gen a
smaller Gen [ContainerCapability]
forall a. Arbitrary a => Gen a
arbitrary Gen (RamSize -> Maybe FilePath -> LibVirtLXCConfig)
-> Gen RamSize -> Gen (Maybe FilePath -> LibVirtLXCConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    RamSize -> Gen RamSize
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> SizeUnit -> RamSize
RamSize Int
4 SizeUnit
GB) Gen (Maybe FilePath -> LibVirtLXCConfig)
-> Gen (Maybe FilePath) -> Gen LibVirtLXCConfig
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>
    Gen (Maybe FilePath) -> Gen (Maybe FilePath)
forall a. Gen a -> Gen a
smaller ([Gen (Maybe FilePath)] -> Gen (Maybe FilePath)
forall a. [Gen a] -> Gen a
oneof [Maybe FilePath -> Gen (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing, FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath)
-> Gen FilePath -> Gen (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen FilePath
arbitraryFilePath])

makeLenses ''LibVirtLXCConfig

defaultLibVirtLXCConfig :: LibVirtLXCConfig
defaultLibVirtLXCConfig :: LibVirtLXCConfig
defaultLibVirtLXCConfig =
  Bool
-> Maybe FilePath
-> FilePath
-> Maybe FilePath
-> [ContainerCapability]
-> RamSize
-> Maybe FilePath
-> LibVirtLXCConfig
LibVirtLXCConfig
    Bool
True
    (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
"/usr/lib/libvirt/libvirt_lxc")
    FilePath
"lxc:///"
    Maybe FilePath
forall a. Maybe a
Nothing
    [ ContainerCapability
CAP_MKNOD,
      ContainerCapability
CAP_SYS_ADMIN,
      ContainerCapability
CAP_SYS_CHROOT,
      ContainerCapability
CAP_SETGID,
      ContainerCapability
CAP_SETUID,
      ContainerCapability
CAP_NET_BIND_SERVICE,
      ContainerCapability
CAP_SETPCAP,
      ContainerCapability
CAP_SYS_PTRACE,
      ContainerCapability
CAP_SYS_MODULE
    ]
    (Int -> SizeUnit -> RamSize
RamSize Int
1 SizeUnit
GB)
    Maybe FilePath
forall a. Maybe a
Nothing

cfgFileSection :: String
cfgFileSection :: FilePath
cfgFileSection = FilePath
"libvirt-lxc"

useSudoK :: String
useSudoK :: FilePath
useSudoK = FilePath
"use_sudo"

emulatorK :: String
emulatorK :: FilePath
emulatorK = FilePath
"emulator_path"

-- NOTE: This variable name is also specified in the NIX build
-- in @default.nix@.
emulatorEnvVar :: String
emulatorEnvVar :: FilePath
emulatorEnvVar = FilePath
"B9_LIBVIRT_LXC"

virshURIK :: String
virshURIK :: FilePath
virshURIK = FilePath
"connection"

networkIdK :: String
networkIdK :: FilePath
networkIdK = FilePath
"network"

guestRamSizeK :: String
guestRamSizeK :: FilePath
guestRamSizeK = FilePath
"guest_ram_size"

imageFileNamesShortenerBasePathK :: String
imageFileNamesShortenerBasePathK :: FilePath
imageFileNamesShortenerBasePathK = FilePath
"image_file_names_shortener_base_path"

libVirtLXCConfigToCPDocument ::
  LibVirtLXCConfig -> CPDocument -> Either CPError CPDocument
libVirtLXCConfigToCPDocument :: LibVirtLXCConfig -> CPDocument -> Either CPError CPDocument
libVirtLXCConfigToCPDocument LibVirtLXCConfig
c CPDocument
cp = do
  CPDocument
cp1 <- CPDocument -> FilePath -> Either CPError CPDocument
forall (m :: * -> *).
MonadError CPError m =>
CPDocument -> FilePath -> m CPDocument
addSectionCP CPDocument
cp FilePath
cfgFileSection
  CPDocument
cp2 <- CPDocument
-> FilePath -> FilePath -> Bool -> Either CPError CPDocument
forall a (m :: * -> *).
(Show a, MonadError CPError m) =>
CPDocument -> FilePath -> FilePath -> a -> m CPDocument
setShowCP CPDocument
cp1 FilePath
cfgFileSection FilePath
useSudoK (Bool -> Either CPError CPDocument)
-> Bool -> Either CPError CPDocument
forall a b. (a -> b) -> a -> b
$ LibVirtLXCConfig -> Bool
useSudo LibVirtLXCConfig
c
  CPDocument
cp3 <- CPDocument
-> FilePath
-> FilePath
-> Maybe FilePath
-> Either CPError CPDocument
forall a (m :: * -> *).
(Show a, MonadError CPError m) =>
CPDocument -> FilePath -> FilePath -> a -> m CPDocument
setShowCP CPDocument
cp2 FilePath
cfgFileSection FilePath
emulatorK (Maybe FilePath -> Either CPError CPDocument)
-> Maybe FilePath -> Either CPError CPDocument
forall a b. (a -> b) -> a -> b
$ LibVirtLXCConfig -> Maybe FilePath
emulator LibVirtLXCConfig
c
  CPDocument
cp4 <- CPDocument
-> FilePath -> FilePath -> FilePath -> Either CPError CPDocument
forall (m :: * -> *).
MonadError CPError m =>
CPDocument -> FilePath -> FilePath -> FilePath -> m CPDocument
setCP CPDocument
cp3 FilePath
cfgFileSection FilePath
virshURIK (FilePath -> Either CPError CPDocument)
-> FilePath -> Either CPError CPDocument
forall a b. (a -> b) -> a -> b
$ LibVirtLXCConfig -> FilePath
virshURI LibVirtLXCConfig
c
  CPDocument
cp5 <- CPDocument
-> FilePath
-> FilePath
-> Maybe FilePath
-> Either CPError CPDocument
forall a (m :: * -> *).
(Show a, MonadError CPError m) =>
CPDocument -> FilePath -> FilePath -> a -> m CPDocument
setShowCP CPDocument
cp4 FilePath
cfgFileSection FilePath
networkIdK (Maybe FilePath -> Either CPError CPDocument)
-> Maybe FilePath -> Either CPError CPDocument
forall a b. (a -> b) -> a -> b
$ LibVirtLXCConfig -> Maybe FilePath
_networkId LibVirtLXCConfig
c
  CPDocument
cp6 <- CPDocument
-> FilePath -> [ContainerCapability] -> Either CPError CPDocument
containerCapsToCPDocument CPDocument
cp5 FilePath
cfgFileSection ([ContainerCapability] -> Either CPError CPDocument)
-> [ContainerCapability] -> Either CPError CPDocument
forall a b. (a -> b) -> a -> b
$ LibVirtLXCConfig -> [ContainerCapability]
guestCapabilities LibVirtLXCConfig
c
  CPDocument
cp7 <- CPDocument
-> FilePath -> FilePath -> RamSize -> Either CPError CPDocument
forall a (m :: * -> *).
(Show a, MonadError CPError m) =>
CPDocument -> FilePath -> FilePath -> a -> m CPDocument
setShowCP CPDocument
cp6 FilePath
cfgFileSection FilePath
guestRamSizeK (RamSize -> Either CPError CPDocument)
-> RamSize -> Either CPError CPDocument
forall a b. (a -> b) -> a -> b
$ LibVirtLXCConfig -> RamSize
guestRamSize LibVirtLXCConfig
c
  CPDocument
cpFinal <- CPDocument
-> FilePath
-> FilePath
-> Maybe FilePath
-> Either CPError CPDocument
forall a (m :: * -> *).
(Show a, MonadError CPError m) =>
CPDocument -> FilePath -> FilePath -> a -> m CPDocument
setShowCP CPDocument
cp7 FilePath
cfgFileSection FilePath
imageFileNamesShortenerBasePathK (Maybe FilePath -> Either CPError CPDocument)
-> Maybe FilePath -> Either CPError CPDocument
forall a b. (a -> b) -> a -> b
$ LibVirtLXCConfig -> Maybe FilePath
imageFileNameShortenerBasePath LibVirtLXCConfig
c
  CPDocument -> Either CPError CPDocument
forall (m :: * -> *) a. Monad m => a -> m a
return CPDocument
cpFinal

parseLibVirtLXCConfig :: CPDocument -> Either CPError LibVirtLXCConfig
parseLibVirtLXCConfig :: CPDocument -> Either CPError LibVirtLXCConfig
parseLibVirtLXCConfig CPDocument
cp =
  let getr :: (CPGet a) => CPOptionSpec -> Either CPError a
      getr :: FilePath -> Either CPError a
getr = CPDocument -> FilePath -> FilePath -> Either CPError a
forall a (m :: * -> *).
(CPGet a, MonadError CPError m) =>
CPDocument -> FilePath -> FilePath -> m a
readCP CPDocument
cp FilePath
cfgFileSection
   in Bool
-> Maybe FilePath
-> FilePath
-> Maybe FilePath
-> [ContainerCapability]
-> RamSize
-> Maybe FilePath
-> LibVirtLXCConfig
LibVirtLXCConfig
        (Bool
 -> Maybe FilePath
 -> FilePath
 -> Maybe FilePath
 -> [ContainerCapability]
 -> RamSize
 -> Maybe FilePath
 -> LibVirtLXCConfig)
-> Either CPError Bool
-> Either
     CPError
     (Maybe FilePath
      -> FilePath
      -> Maybe FilePath
      -> [ContainerCapability]
      -> RamSize
      -> Maybe FilePath
      -> LibVirtLXCConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> Either CPError Bool
forall a. CPGet a => FilePath -> Either CPError a
getr FilePath
useSudoK
        Either
  CPError
  (Maybe FilePath
   -> FilePath
   -> Maybe FilePath
   -> [ContainerCapability]
   -> RamSize
   -> Maybe FilePath
   -> LibVirtLXCConfig)
-> Either CPError (Maybe FilePath)
-> Either
     CPError
     (FilePath
      -> Maybe FilePath
      -> [ContainerCapability]
      -> RamSize
      -> Maybe FilePath
      -> LibVirtLXCConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> Either CPError (Maybe FilePath)
forall a. CPGet a => FilePath -> Either CPError a
getr FilePath
emulatorK
        Either
  CPError
  (FilePath
   -> Maybe FilePath
   -> [ContainerCapability]
   -> RamSize
   -> Maybe FilePath
   -> LibVirtLXCConfig)
-> Either CPError FilePath
-> Either
     CPError
     (Maybe FilePath
      -> [ContainerCapability]
      -> RamSize
      -> Maybe FilePath
      -> LibVirtLXCConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> Either CPError FilePath
forall a. CPGet a => FilePath -> Either CPError a
getr FilePath
virshURIK
        Either
  CPError
  (Maybe FilePath
   -> [ContainerCapability]
   -> RamSize
   -> Maybe FilePath
   -> LibVirtLXCConfig)
-> Either CPError (Maybe FilePath)
-> Either
     CPError
     ([ContainerCapability]
      -> RamSize -> Maybe FilePath -> LibVirtLXCConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> Either CPError (Maybe FilePath)
forall a. CPGet a => FilePath -> Either CPError a
getr FilePath
networkIdK
        Either
  CPError
  ([ContainerCapability]
   -> RamSize -> Maybe FilePath -> LibVirtLXCConfig)
-> Either CPError [ContainerCapability]
-> Either CPError (RamSize -> Maybe FilePath -> LibVirtLXCConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> CPDocument -> FilePath -> Either CPError [ContainerCapability]
parseContainerCapabilities CPDocument
cp FilePath
cfgFileSection
        Either CPError (RamSize -> Maybe FilePath -> LibVirtLXCConfig)
-> Either CPError RamSize
-> Either CPError (Maybe FilePath -> LibVirtLXCConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> Either CPError RamSize
forall a. CPGet a => FilePath -> Either CPError a
getr FilePath
guestRamSizeK
        Either CPError (Maybe FilePath -> LibVirtLXCConfig)
-> Either CPError (Maybe FilePath)
-> Either CPError LibVirtLXCConfig
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> Either CPError (Maybe FilePath)
forall a. CPGet a => FilePath -> Either CPError a
getr FilePath
imageFileNamesShortenerBasePathK

-- | Return the path to @/usr/lib/libvirt/libexec/libvirt_lxc@
--  the 'emulatorK' field from the config file, or set the path
-- in the environment variable named like the value in 'emulatorEnvVar'
-- dictates.
--
-- @since 0.5.66
getEmulatorPath :: MonadIO m => LibVirtLXCConfig -> m FilePath
getEmulatorPath :: LibVirtLXCConfig -> m FilePath
getEmulatorPath LibVirtLXCConfig
cfg =
  IO FilePath -> m FilePath
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (FilePath -> FilePath -> IO FilePath
SysIO.getEnvDefault FilePath
emulatorEnvVar FilePath
fromCfgOrDefault)
  where
    fromCfgOrDefault :: FilePath
fromCfgOrDefault = FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
"/usr/lib/libexec/libvirt_lxc" (LibVirtLXCConfig -> Maybe FilePath
emulator LibVirtLXCConfig
cfg)