module B9.B9Config.SystemdNspawn
  ( systemdNspawnConfigToCPDocument,
    defaultSystemdNspawnConfig,
    parseSystemdNspawnConfig,
    SystemdNspawnConfig (..),
    SystemdNspawnConsole (..),
    systemdNspawnCapabilities,
    systemdNspawnUseSudo,
    systemdNspawnMaxLifetimeSeconds,
    systemdNspawnExtraArgs,
    systemdNspawnExecutable,
    systemdNspawnConsole,
  )
where

import B9.B9Config.Container
import Control.Lens (makeLenses)
import Data.ConfigFile.B9Extras
import qualified Text.ParserCombinators.ReadP as ReadP
import qualified Text.ParserCombinators.ReadPrec as ReadPrec
import Text.Read
import Test.QuickCheck (Arbitrary(arbitrary))
import qualified Test.QuickCheck as QuickCheck
import B9.QCUtil (smaller, arbitraryFilePath)

-- TODO document b9 config file
data SystemdNspawnConfig
  = SystemdNspawnConfig
      { SystemdNspawnConfig -> [ContainerCapability]
_systemdNspawnCapabilities :: [ContainerCapability],
        SystemdNspawnConfig -> Bool
_systemdNspawnUseSudo :: Bool,
        SystemdNspawnConfig -> Maybe Int
_systemdNspawnMaxLifetimeSeconds :: Maybe Int,
        SystemdNspawnConfig -> Maybe String
_systemdNspawnExtraArgs :: Maybe String,
        SystemdNspawnConfig -> Maybe String
_systemdNspawnExecutable :: Maybe FilePath,
        SystemdNspawnConfig -> SystemdNspawnConsole
_systemdNspawnConsole :: SystemdNspawnConsole
      }
  deriving (ReadPrec [SystemdNspawnConfig]
ReadPrec SystemdNspawnConfig
Int -> ReadS SystemdNspawnConfig
ReadS [SystemdNspawnConfig]
(Int -> ReadS SystemdNspawnConfig)
-> ReadS [SystemdNspawnConfig]
-> ReadPrec SystemdNspawnConfig
-> ReadPrec [SystemdNspawnConfig]
-> Read SystemdNspawnConfig
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SystemdNspawnConfig]
$creadListPrec :: ReadPrec [SystemdNspawnConfig]
readPrec :: ReadPrec SystemdNspawnConfig
$creadPrec :: ReadPrec SystemdNspawnConfig
readList :: ReadS [SystemdNspawnConfig]
$creadList :: ReadS [SystemdNspawnConfig]
readsPrec :: Int -> ReadS SystemdNspawnConfig
$creadsPrec :: Int -> ReadS SystemdNspawnConfig
Read, Int -> SystemdNspawnConfig -> ShowS
[SystemdNspawnConfig] -> ShowS
SystemdNspawnConfig -> String
(Int -> SystemdNspawnConfig -> ShowS)
-> (SystemdNspawnConfig -> String)
-> ([SystemdNspawnConfig] -> ShowS)
-> Show SystemdNspawnConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SystemdNspawnConfig] -> ShowS
$cshowList :: [SystemdNspawnConfig] -> ShowS
show :: SystemdNspawnConfig -> String
$cshow :: SystemdNspawnConfig -> String
showsPrec :: Int -> SystemdNspawnConfig -> ShowS
$cshowsPrec :: Int -> SystemdNspawnConfig -> ShowS
Show, SystemdNspawnConfig -> SystemdNspawnConfig -> Bool
(SystemdNspawnConfig -> SystemdNspawnConfig -> Bool)
-> (SystemdNspawnConfig -> SystemdNspawnConfig -> Bool)
-> Eq SystemdNspawnConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SystemdNspawnConfig -> SystemdNspawnConfig -> Bool
$c/= :: SystemdNspawnConfig -> SystemdNspawnConfig -> Bool
== :: SystemdNspawnConfig -> SystemdNspawnConfig -> Bool
$c== :: SystemdNspawnConfig -> SystemdNspawnConfig -> Bool
Eq)

instance Arbitrary SystemdNspawnConfig where 
  arbitrary :: Gen SystemdNspawnConfig
arbitrary = 
    [ContainerCapability]
-> Bool
-> Maybe Int
-> Maybe String
-> Maybe String
-> SystemdNspawnConsole
-> SystemdNspawnConfig
SystemdNspawnConfig 
    ([ContainerCapability]
 -> Bool
 -> Maybe Int
 -> Maybe String
 -> Maybe String
 -> SystemdNspawnConsole
 -> SystemdNspawnConfig)
-> Gen [ContainerCapability]
-> Gen
     (Bool
      -> Maybe Int
      -> Maybe String
      -> Maybe String
      -> SystemdNspawnConsole
      -> SystemdNspawnConfig)
forall (f :: * -> *) a b. Functor 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
  (Bool
   -> Maybe Int
   -> Maybe String
   -> Maybe String
   -> SystemdNspawnConsole
   -> SystemdNspawnConfig)
-> Gen Bool
-> Gen
     (Maybe Int
      -> Maybe String
      -> Maybe String
      -> SystemdNspawnConsole
      -> SystemdNspawnConfig)
forall (f :: * -> *) a b. Applicative f => 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 Int
   -> Maybe String
   -> Maybe String
   -> SystemdNspawnConsole
   -> SystemdNspawnConfig)
-> Gen (Maybe Int)
-> Gen
     (Maybe String
      -> Maybe String -> SystemdNspawnConsole -> SystemdNspawnConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Int) -> Gen (Maybe Int)
forall a. Gen a -> Gen a
smaller Gen (Maybe Int)
forall a. Arbitrary a => Gen a
arbitrary
    Gen
  (Maybe String
   -> Maybe String -> SystemdNspawnConsole -> SystemdNspawnConfig)
-> Gen (Maybe String)
-> Gen
     (Maybe String -> SystemdNspawnConsole -> SystemdNspawnConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe String) -> Gen (Maybe String)
forall a. Gen a -> Gen a
smaller Gen (Maybe String)
forall a. Arbitrary a => Gen a
arbitrary
    Gen (Maybe String -> SystemdNspawnConsole -> SystemdNspawnConfig)
-> Gen (Maybe String)
-> Gen (SystemdNspawnConsole -> SystemdNspawnConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe String) -> Gen (Maybe String)
forall a. Gen a -> Gen a
smaller ([Gen (Maybe String)] -> Gen (Maybe String)
forall a. [Gen a] -> Gen a
QuickCheck.oneof [Maybe String -> Gen (Maybe String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing, String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> Gen String -> Gen (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
arbitraryFilePath])
    Gen (SystemdNspawnConsole -> SystemdNspawnConfig)
-> Gen SystemdNspawnConsole -> Gen SystemdNspawnConfig
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen SystemdNspawnConsole -> Gen SystemdNspawnConsole
forall a. Gen a -> Gen a
smaller Gen SystemdNspawnConsole
forall a. Arbitrary a => Gen a
arbitrary

data SystemdNspawnConsole
  = SystemdNspawnInteractive
  | SystemdNspawnReadOnly
  | SystemdNspawnPassive
  | SystemdNspawnPipe
  deriving (SystemdNspawnConsole -> SystemdNspawnConsole -> Bool
(SystemdNspawnConsole -> SystemdNspawnConsole -> Bool)
-> (SystemdNspawnConsole -> SystemdNspawnConsole -> Bool)
-> Eq SystemdNspawnConsole
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SystemdNspawnConsole -> SystemdNspawnConsole -> Bool
$c/= :: SystemdNspawnConsole -> SystemdNspawnConsole -> Bool
== :: SystemdNspawnConsole -> SystemdNspawnConsole -> Bool
$c== :: SystemdNspawnConsole -> SystemdNspawnConsole -> Bool
Eq)

instance Arbitrary SystemdNspawnConsole where
  arbitrary :: Gen SystemdNspawnConsole
arbitrary = 
    [SystemdNspawnConsole] -> Gen SystemdNspawnConsole
forall a. [a] -> Gen a
QuickCheck.elements 
      [ SystemdNspawnConsole
SystemdNspawnInteractive
      , SystemdNspawnConsole
SystemdNspawnReadOnly
      , SystemdNspawnConsole
SystemdNspawnPassive
      , SystemdNspawnConsole
SystemdNspawnPipe
      ]
          
instance Show SystemdNspawnConsole where
  show :: SystemdNspawnConsole -> String
show SystemdNspawnConsole
x = case SystemdNspawnConsole
x of
    SystemdNspawnConsole
SystemdNspawnInteractive -> String
"interactive"
    SystemdNspawnConsole
SystemdNspawnReadOnly -> String
"read-only"
    SystemdNspawnConsole
SystemdNspawnPassive -> String
"passive"
    SystemdNspawnConsole
SystemdNspawnPipe -> String
"pipe"

instance Read SystemdNspawnConsole where
  readPrec :: ReadPrec SystemdNspawnConsole
readPrec =
    do
      Ident String
"interactive" <- ReadPrec Lexeme
lexP
      SystemdNspawnConsole -> ReadPrec SystemdNspawnConsole
forall (m :: * -> *) a. Monad m => a -> m a
return SystemdNspawnConsole
SystemdNspawnInteractive
      ReadPrec SystemdNspawnConsole
-> ReadPrec SystemdNspawnConsole -> ReadPrec SystemdNspawnConsole
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++ ReadP SystemdNspawnConsole -> ReadPrec SystemdNspawnConsole
forall a. ReadP a -> ReadPrec a
ReadPrec.lift
        ( do
            ReadP ()
ReadP.skipSpaces
            String
_ <- String -> ReadP String
ReadP.string String
"read-only"
            SystemdNspawnConsole -> ReadP SystemdNspawnConsole
forall (m :: * -> *) a. Monad m => a -> m a
return SystemdNspawnConsole
SystemdNspawnReadOnly
        )
      ReadPrec SystemdNspawnConsole
-> ReadPrec SystemdNspawnConsole -> ReadPrec SystemdNspawnConsole
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++ do
        Ident String
"passive" <- ReadPrec Lexeme
lexP
        SystemdNspawnConsole -> ReadPrec SystemdNspawnConsole
forall (m :: * -> *) a. Monad m => a -> m a
return SystemdNspawnConsole
SystemdNspawnPassive
      ReadPrec SystemdNspawnConsole
-> ReadPrec SystemdNspawnConsole -> ReadPrec SystemdNspawnConsole
forall a. ReadPrec a -> ReadPrec a -> ReadPrec a
+++ do
        Ident String
"pipe" <- ReadPrec Lexeme
lexP
        SystemdNspawnConsole -> ReadPrec SystemdNspawnConsole
forall (m :: * -> *) a. Monad m => a -> m a
return SystemdNspawnConsole
SystemdNspawnPipe

makeLenses ''SystemdNspawnConfig

defaultSystemdNspawnConfig :: SystemdNspawnConfig
defaultSystemdNspawnConfig :: SystemdNspawnConfig
defaultSystemdNspawnConfig =
  [ContainerCapability]
-> Bool
-> Maybe Int
-> Maybe String
-> Maybe String
-> SystemdNspawnConsole
-> SystemdNspawnConfig
SystemdNspawnConfig
    [ 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
    ]
    Bool
True
    (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3600))
    Maybe String
forall a. Maybe a
Nothing
    Maybe String
forall a. Maybe a
Nothing
    SystemdNspawnConsole
SystemdNspawnReadOnly

cfgFileSection :: String
cfgFileSection :: String
cfgFileSection = String
"systemdNspawn"

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

maxLifetimeSecondsK :: String
maxLifetimeSecondsK :: String
maxLifetimeSecondsK = String
"max_lifetime_seconds"

extraArgsK :: String
extraArgsK :: String
extraArgsK = String
"extra_args"

executableK :: String
executableK :: String
executableK = String
"executable"

consoleK :: String
consoleK :: String
consoleK = String
"console"

systemdNspawnConfigToCPDocument ::
  SystemdNspawnConfig -> CPDocument -> Either CPError CPDocument
systemdNspawnConfigToCPDocument :: SystemdNspawnConfig -> CPDocument -> Either CPError CPDocument
systemdNspawnConfigToCPDocument SystemdNspawnConfig
c CPDocument
cp = do
  CPDocument
cp1 <- CPDocument -> String -> Either CPError CPDocument
forall (m :: * -> *).
MonadError CPError m =>
CPDocument -> String -> m CPDocument
addSectionCP CPDocument
cp String
cfgFileSection
  CPDocument
cp2 <-
    CPDocument
-> String -> [ContainerCapability] -> Either CPError CPDocument
containerCapsToCPDocument CPDocument
cp1 String
cfgFileSection ([ContainerCapability] -> Either CPError CPDocument)
-> [ContainerCapability] -> Either CPError CPDocument
forall a b. (a -> b) -> a -> b
$
      SystemdNspawnConfig -> [ContainerCapability]
_systemdNspawnCapabilities SystemdNspawnConfig
c
  CPDocument
cp3 <- CPDocument -> String -> String -> Bool -> Either CPError CPDocument
forall a (m :: * -> *).
(Show a, MonadError CPError m) =>
CPDocument -> String -> String -> a -> m CPDocument
setShowCP CPDocument
cp2 String
cfgFileSection String
useSudoK (Bool -> Either CPError CPDocument)
-> Bool -> Either CPError CPDocument
forall a b. (a -> b) -> a -> b
$ SystemdNspawnConfig -> Bool
_systemdNspawnUseSudo SystemdNspawnConfig
c
  CPDocument
cp4 <- CPDocument
-> String -> String -> Maybe Int -> Either CPError CPDocument
forall a (m :: * -> *).
(Show a, MonadError CPError m) =>
CPDocument -> String -> String -> a -> m CPDocument
setShowCP CPDocument
cp3 String
cfgFileSection String
maxLifetimeSecondsK (Maybe Int -> Either CPError CPDocument)
-> Maybe Int -> Either CPError CPDocument
forall a b. (a -> b) -> a -> b
$ SystemdNspawnConfig -> Maybe Int
_systemdNspawnMaxLifetimeSeconds SystemdNspawnConfig
c
  CPDocument
cp5 <- CPDocument
-> String -> String -> Maybe String -> Either CPError CPDocument
forall a (m :: * -> *).
(Show a, MonadError CPError m) =>
CPDocument -> String -> String -> a -> m CPDocument
setShowCP CPDocument
cp4 String
cfgFileSection String
extraArgsK (Maybe String -> Either CPError CPDocument)
-> Maybe String -> Either CPError CPDocument
forall a b. (a -> b) -> a -> b
$ SystemdNspawnConfig -> Maybe String
_systemdNspawnExtraArgs SystemdNspawnConfig
c
  CPDocument
cp6 <- CPDocument
-> String -> String -> Maybe String -> Either CPError CPDocument
forall a (m :: * -> *).
(Show a, MonadError CPError m) =>
CPDocument -> String -> String -> a -> m CPDocument
setShowCP CPDocument
cp5 String
cfgFileSection String
executableK (Maybe String -> Either CPError CPDocument)
-> Maybe String -> Either CPError CPDocument
forall a b. (a -> b) -> a -> b
$ SystemdNspawnConfig -> Maybe String
_systemdNspawnExecutable SystemdNspawnConfig
c
  CPDocument
-> String
-> String
-> SystemdNspawnConsole
-> Either CPError CPDocument
forall a (m :: * -> *).
(Show a, MonadError CPError m) =>
CPDocument -> String -> String -> a -> m CPDocument
setShowCP CPDocument
cp6 String
cfgFileSection String
consoleK (SystemdNspawnConsole -> Either CPError CPDocument)
-> SystemdNspawnConsole -> Either CPError CPDocument
forall a b. (a -> b) -> a -> b
$ SystemdNspawnConfig -> SystemdNspawnConsole
_systemdNspawnConsole SystemdNspawnConfig
c

parseSystemdNspawnConfig :: CPDocument -> Either CPError SystemdNspawnConfig
parseSystemdNspawnConfig :: CPDocument -> Either CPError SystemdNspawnConfig
parseSystemdNspawnConfig CPDocument
cp =
  let getr :: (CPGet a) => CPOptionSpec -> Either CPError a
      getr :: String -> Either CPError a
getr = CPDocument -> String -> String -> Either CPError a
forall a (m :: * -> *).
(CPGet a, MonadError CPError m) =>
CPDocument -> String -> String -> m a
readCP CPDocument
cp String
cfgFileSection
   in [ContainerCapability]
-> Bool
-> Maybe Int
-> Maybe String
-> Maybe String
-> SystemdNspawnConsole
-> SystemdNspawnConfig
SystemdNspawnConfig
        ([ContainerCapability]
 -> Bool
 -> Maybe Int
 -> Maybe String
 -> Maybe String
 -> SystemdNspawnConsole
 -> SystemdNspawnConfig)
-> Either CPError [ContainerCapability]
-> Either
     CPError
     (Bool
      -> Maybe Int
      -> Maybe String
      -> Maybe String
      -> SystemdNspawnConsole
      -> SystemdNspawnConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CPDocument -> String -> Either CPError [ContainerCapability]
parseContainerCapabilities CPDocument
cp String
cfgFileSection
        Either
  CPError
  (Bool
   -> Maybe Int
   -> Maybe String
   -> Maybe String
   -> SystemdNspawnConsole
   -> SystemdNspawnConfig)
-> Either CPError Bool
-> Either
     CPError
     (Maybe Int
      -> Maybe String
      -> Maybe String
      -> SystemdNspawnConsole
      -> SystemdNspawnConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Either CPError Bool
forall a. CPGet a => String -> Either CPError a
getr String
useSudoK
        Either
  CPError
  (Maybe Int
   -> Maybe String
   -> Maybe String
   -> SystemdNspawnConsole
   -> SystemdNspawnConfig)
-> Either CPError (Maybe Int)
-> Either
     CPError
     (Maybe String
      -> Maybe String -> SystemdNspawnConsole -> SystemdNspawnConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Either CPError (Maybe Int)
forall a. CPGet a => String -> Either CPError a
getr String
maxLifetimeSecondsK
        Either
  CPError
  (Maybe String
   -> Maybe String -> SystemdNspawnConsole -> SystemdNspawnConfig)
-> Either CPError (Maybe String)
-> Either
     CPError
     (Maybe String -> SystemdNspawnConsole -> SystemdNspawnConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Either CPError (Maybe String)
forall a. CPGet a => String -> Either CPError a
getr String
extraArgsK
        Either
  CPError
  (Maybe String -> SystemdNspawnConsole -> SystemdNspawnConfig)
-> Either CPError (Maybe String)
-> Either CPError (SystemdNspawnConsole -> SystemdNspawnConfig)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Either CPError (Maybe String)
forall a. CPGet a => String -> Either CPError a
getr String
executableK
        Either CPError (SystemdNspawnConsole -> SystemdNspawnConfig)
-> Either CPError SystemdNspawnConsole
-> Either CPError SystemdNspawnConfig
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Either CPError SystemdNspawnConsole
forall a. CPGet a => String -> Either CPError a
getr String
consoleK