b9 1.1.1 → 2.0.0

raw patch · 16 files changed

+392/−115 lines, 16 filesdep +neat-interpolationdep ~ConfigFiledep ~QuickCheckdep ~aesonPVP ok

version bump matches the API change (PVP)

Dependencies added: neat-interpolation

Dependency ranges changed: ConfigFile, QuickCheck, aeson, async, base64-bytestring, bifunctors, binary, boxes, bytestring, conduit, conduit-extra, containers, directory, exceptions, filepath, free, hashable, hspec, hspec-expectations, lens, monad-control, mtl, optparse-applicative, parallel, parsec, pretty, pretty-show, process, random, syb, template, text, time, transformers, unordered-containers, vector, yaml

API changes (from Hackage documentation)

Files

• CHANGELOG.md +20/−0
• b9.cabal +43/−54
• src/lib/B9.hs +5/−4
• src/lib/B9/B9Config.hs +51/−23
• src/lib/B9/B9Config/Container.hs +8/−1
• src/lib/B9/B9Config/LibVirtLXC.hs +12/−0
• src/lib/B9/B9Config/Repository.hs +29/−6
• src/lib/B9/B9Config/SystemdNspawn.hs +23/−1
• src/lib/B9/B9Exec.hs +28/−6
• src/lib/B9/B9Monad.hs +20/−2
• src/lib/B9/BuildInfo.hs +13/−3
• src/lib/B9/LibVirtLXC.hs +2/−2
• src/lib/B9/Repository.hs +4/−3
• src/lib/B9/RepositoryIO.hs +6/−6
• src/lib/B9/SystemdNspawn.hs +12/−4
• src/tests/B9/B9ConfigSpec.hs +116/−0

@@ -1,5 +1,25 @@ # Changelog for B9 +## 2.0.0++### Breaking Changes++* Specify upper version bounds for all project dependencies+* Move the `interactive` flag from the `B9Config` to the `BuildInfo`+  * `isInteractive` now requires the `BuildInfoReader` effect +  * Add the `runB9Interactive` function, that can by used to +    make the `bsIsInteractive` field in `BuildInfo` `True`+  * Add the `cmdInteractive` function, that executes a command +    with inherited stdin/stdout if `runB9Interactive` was called.+  * Remove the interactivity functionality from the `cmd` function   ++### Minor Changes++* Fix bug in the parsing of `console` key in the `systemd-nspawn` +  configuration section: When a user specifies `console: pipe` +  this effects will be the same as if `console: read-only` was specified.+* Fix bug where the timeout factor configuration option given in a +  configuration file is ignored.  ## 1.1.1 

@@ -1,6 +1,6 @@ cabal-version:       2.4 name:                b9-version:             1.1.1+version:             2.0.0  synopsis:            A tool and library for building virtual machine images. @@ -57,15 +57,25 @@                    , CHANGELOG.md  common b9Deps-  build-depends:     base >= 4.12 && < 5-                   , bytestring >= 0.10.8-                   , directory >= 1.3-                   , extensible-effects >= 5 && < 6-                   , hspec-                   , hspec-expectations-                   , lens >= 4+  build-depends:     QuickCheck >= 2.5 && < 3+                   , aeson == 1.4.*+                   , base >= 4.12 && < 5+                   , binary == 0.8.*+                   , bytestring >= 0.10.8 && < 1+                   , containers >= 0.6 && < 1+                   , directory >= 1.3 && < 2+                   , extensible-effects == 5.*+                   , filepath == 1.4.*+                   , hspec == 2.7.*+                   , hspec-expectations == 0.8.*+                   , lens == 4.*+                   , neat-interpolation >= 0.3 && < 1+                   , optparse-applicative >= 0.13 && < 1                    , shake >= 0.17.6 && < 0.19-                   , text >= 1.2+                   , text == 1.2.*+                   , unordered-containers >= 0.2 && < 1+                   , vector >= 0.11 && < 1+                   , yaml >= 0.8 && < 1  common b9Extensions   other-extensions: OverloadedStrings@@ -150,39 +160,29 @@                    , System.IO.B9Extras   other-modules:   Paths_b9   autogen-modules: Paths_b9-  build-depends:     ConfigFile >= 1.1.4-                   , QuickCheck >= 2.5-                   , aeson >= 1.0-                   , async >= 2.1-                   , base64-bytestring-                   , bifunctors >= 5.4-                   , binary >= 0.8.3-                   , boxes >= 0.1.4-                   , conduit >= 1.2-                   , conduit-extra >= 1.1-                   -- , dhall >= 1 TODO-                   , containers -                   , exceptions >= 0.10-                   , filepath >= 1.4-                   , free >= 4.12-                   , hashable >= 1.2-                   , monad-control >= 1.0 && < 1.1-                   , mtl >= 2.2-                   , optparse-applicative >= 0.14-                   , parallel >= 3.2-                   , parsec >= 3.1-                   , pretty >= 1.1-                   , pretty-show >= 1.6-                   , process >= 1.4-                   , random >= 1.1-                   , syb >= 0.6+  build-depends:     ConfigFile >= 1.1.4 && < 1.2+                   , async == 2.*+                   , base64-bytestring == 1.*+                   , bifunctors == 5.*+                   , boxes == 0.1.*+                   , conduit == 1.*+                   , conduit-extra == 1.*+                   , exceptions == 0.10.*+                   , free >= 4.12 && < 6+                   , hashable == 1.2.*+                   , monad-control == 1.*+                   , mtl == 2.*+                   , parallel >= 3.2 && < 4+                   , parsec >= 3.1 && < 4+                   , pretty >= 1.1 && < 2+                   , pretty-show >= 1.6 && < 2+                   , process >= 1.4 && < 2+                   , random >= 1.1 && < 2+                   , syb >= 0.6 && < 1                    , tagged >= 0.8 && < 0.9-                   , template >= 0.2-                   , time >= 1.6-                   , transformers >= 0.5-                   , unordered-containers >= 0.2.8-                   , vector >= 0.11-                   , yaml >= 0.8+                   , template >= 0.2 && < 1+                   , time >= 1.6 && < 2+                   , transformers >= 0.5 && < 1  executable b9c   import:           b9Extensions, b9Deps@@ -190,8 +190,6 @@   other-modules:     Paths_b9   autogen-modules:   Paths_b9   build-depends:     b9-                   , extensible-effects >= 5 && < 6-                   , optparse-applicative >= 0.13   hs-source-dirs:    src/cli   ghc-options:       -Wall                      -fwarn-unused-binds -fno-warn-unused-do-bind -threaded@@ -204,6 +202,7 @@   main-is:           Spec.hs   autogen-modules:   Paths_b9   other-modules:     B9.ArtifactGeneratorImplSpec+                   , B9.B9ConfigSpec                    , B9.B9ExecSpec                    , B9.Content.ErlTermsSpec                    , B9.Content.ErlangPropListSpec@@ -214,14 +213,4 @@                    , B9.RepositorySpec                    , B9.Shake.SharedImageRulesSpec                    , Paths_b9-  build-depends:     QuickCheck >= 2.5-                   , b9-                   , aeson >= 1.0-                   , binary >= 0.8 && < 0.9-                   , containers-                   , filepath-                   , hspec-                   , hspec-expectations-                   , unordered-containers >= 0.2-                   , vector >= 0.11-                   , yaml >= 0.8+  build-depends:     b9

@@ -75,6 +75,7 @@ import Data.Maybe as X import Data.Monoid as X import Data.Set (Set)+import qualified Data.Set as Set import Data.Version as X import Paths_b9 (version) import System.Exit as X@@ -160,8 +161,8 @@ runRun :: SharedImageName -> [String] -> B9ConfigAction String runRun (SharedImageName name) cmdAndArgs =   localB9Config-    ((keepTempDirs .~ False) . (interactive .~ True))-    (runB9 (buildArtifacts runCmdAndArgs))+    ((keepTempDirs .~ False) . (verbosity .~ Just LogTrace))+    (runB9Interactive (buildArtifacts runCmdAndArgs))   where     runCmdAndArgs =       Artifact@@ -245,8 +246,8 @@   modifyPermanentConfig     ( Endo         ( remoteRepos-            %~ ( mappend [repo']-                   . filter ((== remoteRepoRepoId repo') . remoteRepoRepoId)+            %~ ( mappend (Set.singleton repo')+                   . Set.filter ((== remoteRepoRepoId repo') . remoteRepoRepoId)                )         )     )

@@ -13,7 +13,6 @@     getLogVerbosity,     getProjectRoot,     getRemoteRepos,-    isInteractive,     B9ConfigWriter,     verbosity,     logFile,@@ -22,7 +21,6 @@     uniqueBuildDirs,     repositoryCache,     repository,-    interactive,     defaultTimeout,     libVirtLXCConfigs,     dockerConfigs,@@ -73,6 +71,7 @@ import B9.B9Config.Repository as X import B9.B9Config.SystemdNspawn as X import B9.Environment+import B9.QCUtil (smaller) import Control.Eff import Control.Eff.Reader.Lazy import Control.Eff.Writer.Lazy@@ -99,6 +98,8 @@ import Data.Maybe (fromMaybe) import Data.Monoid import Data.Semigroup as Semigroup hiding (Last (..))+import Data.Set (Set)+import qualified Data.Set as Set import Data.Version import GHC.Stack import qualified Paths_b9 as My@@ -106,6 +107,8 @@ import System.FilePath ((<.>)) import System.IO.B9Extras (SystemPath (..), ensureDir, resolve) import Text.Printf (printf)+import Test.QuickCheck (Arbitrary(arbitrary))+import qualified Test.QuickCheck as QuickCheck  -- | A way to specify a time intervall for example for the timeouts -- of system commands.@@ -114,6 +117,11 @@ newtype Timeout = TimeoutMicros Int   deriving (Show, Eq, Ord, Read) +instance Arbitrary Timeout where+  arbitrary = do +    QuickCheck.Positive t <- arbitrary +    pure (TimeoutMicros (t * 1_000_000))+ data LogLevel   = LogTrace   | LogDebug@@ -122,6 +130,9 @@   | LogNothing   deriving (Eq, Show, Ord, Read) +instance Arbitrary LogLevel where +  arbitrary = QuickCheck.elements [LogTrace, LogDebug, LogInfo, LogError, LogNothing]+ data B9Config   = B9Config       { _verbosity :: Maybe LogLevel,@@ -131,18 +142,36 @@         _uniqueBuildDirs :: Bool,         _repositoryCache :: Maybe SystemPath,         _repository :: Maybe String,-        _interactive :: Bool,         _maxLocalSharedImageRevisions :: Maybe Int,         _systemdNspawnConfigs :: Maybe SystemdNspawnConfig,         _podmanConfigs :: Maybe PodmanConfig,         _dockerConfigs :: Maybe DockerConfig,         _libVirtLXCConfigs :: Maybe LibVirtLXCConfig,-        _remoteRepos :: [RemoteRepo],+        _remoteRepos :: Set RemoteRepo,         _defaultTimeout :: Maybe Timeout,         _timeoutFactor :: Maybe Int       }   deriving (Show, Eq) +instance Arbitrary B9Config where +  arbitrary = +    B9Config +      <$> smaller arbitrary +      <*> smaller arbitrary +      <*> smaller arbitrary +      <*> smaller arbitrary +      <*> smaller arbitrary +      <*> (QuickCheck.elements [Nothing, Just (InTempDir "xxx")])+      <*> smaller arbitrary +      <*> smaller (fmap QuickCheck.getPositive <$> arbitrary)+      <*> smaller arbitrary +      <*> pure Nothing+      <*> pure Nothing+      <*> smaller arbitrary +      <*> smaller arbitrary +      <*> smaller arbitrary +      <*> (fmap QuickCheck.getPositive <$> smaller arbitrary)+ instance Semigroup B9Config where   c <> c' =     B9Config@@ -153,7 +182,6 @@         _uniqueBuildDirs = getAll ((mappend `on` (All . _uniqueBuildDirs)) c c'),         _repositoryCache = getLast $ on mappend (Last . _repositoryCache) c c',         _repository = getLast ((mappend `on` (Last . _repository)) c c'),-        _interactive = getAny ((mappend `on` (Any . _interactive)) c c'),         _maxLocalSharedImageRevisions = getLast ((mappend `on` (Last . _maxLocalSharedImageRevisions)) c c'),         _systemdNspawnConfigs = getLast ((mappend `on` (Last . _systemdNspawnConfigs)) c c'),         _podmanConfigs = getLast ((mappend `on` (Last . _podmanConfigs)) c c'),@@ -166,7 +194,7 @@  instance Monoid B9Config where   mappend = (<>)-  mempty = B9Config Nothing Nothing Nothing False True Nothing Nothing False Nothing Nothing Nothing Nothing Nothing [] (Just (TimeoutMicros (60 * 60 * 1_000_000))) Nothing+  mempty = B9Config Nothing Nothing Nothing False True Nothing Nothing Nothing Nothing Nothing Nothing Nothing mempty (Just (TimeoutMicros (60 * 60 * 1_000_000))) Nothing  -- | Reader for 'B9Config'. See 'getB9Config' and 'localB9Config'. --@@ -201,17 +229,10 @@ getConfig :: Member B9ConfigReader e => Eff e B9Config getConfig = getB9Config --- | Ask whether @stdin@ of the @B9@ process should be redirected to the--- external commands executed during the build.------ @since 0.5.65-isInteractive :: Member B9ConfigReader e => Eff e Bool-isInteractive = _interactive <$> getB9Config- -- | Ask for the 'RemoteRepo's. -- -- @since 0.5.65-getRemoteRepos :: Member B9ConfigReader e => Eff e [RemoteRepo]+getRemoteRepos :: Member B9ConfigReader e => Eff e (Set RemoteRepo) getRemoteRepos = _remoteRepos <$> getB9Config  -- | Ask for the 'LogLevel'.@@ -413,13 +434,12 @@       _uniqueBuildDirs = True,       _repository = Nothing,       _repositoryCache = Just defaultRepositoryCache,-      _interactive = False,       _maxLocalSharedImageRevisions = Just 2,       _systemdNspawnConfigs = Just defaultSystemdNspawnConfig,       _podmanConfigs = Just defaultPodmanConfig,       _libVirtLXCConfigs = Just defaultLibVirtLXCConfig,       _dockerConfigs = Just defaultDockerConfig,-      _remoteRepos = [],+      _remoteRepos = mempty,       _defaultTimeout = Just (TimeoutMicros (3_600_000_000)),       _timeoutFactor = Nothing     }@@ -485,10 +505,15 @@   cpB <- foldr (>=>) return (podmanConfigToCPDocument <$> _podmanConfigs c) cpA   cpC <- foldr (>=>) return (dockerConfigToCPDocument <$> _dockerConfigs c) cpB   cpD <- foldr (>=>) return (libVirtLXCConfigToCPDocument <$> _libVirtLXCConfigs c) cpC-  cpE <- foldr (>=>) return (remoteRepoToCPDocument <$> _remoteRepos c) cpD-  cpF <- setShowCP cpE cfgFileSection repositoryK (_repository c)-  cpFinal <- setShowCP cpF cfgFileSection defaultTimeoutK (_defaultTimeout c)-  setShowCP cpFinal cfgFileSection timeoutFactorK (_timeoutFactor c)+  cpE <- foldr (>=>) return ( remoteRepoToCPDocument <$> Set.toList (_remoteRepos c)) cpD+  cpF <- setShowCP cpE cfgFileSection repositoryK (_repository c)  +  cpFinal <- maybe (pure cpF) (setShowCP cpF cfgFileSection defaultTimeoutK) +              ( case _defaultTimeout c of +                    Just (TimeoutMicros t) ->+                      Just (t `div` 1_000_000)+                    Nothing -> Nothing+              )+  maybe (pure cpFinal) (setShowCP cpFinal cfgFileSection timeoutFactorK) (_timeoutFactor c)  readB9Config :: (HasCallStack, MonadIO m) => Maybe SystemPath -> m CPDocument readB9Config cfgFile = readCPDocument (fromMaybe defaultB9ConfigFile cfgFile)@@ -497,17 +522,20 @@ parseB9Config cp =   let getr :: (CPGet a) => CPOptionSpec -> Either CPError a       getr = readCP cp cfgFileSection-   in B9Config <$> getr verbosityK <*> getr logFileK <*> getr projectRootK <*> getr keepTempDirsK+   in B9Config +        <$> getr verbosityK +        <*> getr logFileK +        <*> getr projectRootK +        <*> getr keepTempDirsK         <*> getr uniqueBuildDirsK         <*> getr repositoryCacheK         <*> getr repositoryK-        <*> pure False         <*> pure (either (const Nothing) id (getr maxLocalSharedImageRevisionsK))         <*> pure (either (const Nothing) Just (parseSystemdNspawnConfig cp))         <*> pure (either (const Nothing) Just (parsePodmanConfig cp))         <*> pure (either (const Nothing) Just (parseDockerConfig cp))         <*> pure (either (const Nothing) Just (parseLibVirtLXCConfig cp))-        <*> parseRemoteRepos cp+        <*> (Set.fromList <$> parseRemoteRepos cp)         <*> pure (either (const Nothing) Just (parseDefaultTimeoutConfig cp))         <*> pure (either (const Nothing) Just (getr timeoutFactorK)) 

@@ -6,6 +6,8 @@ where  import Data.ConfigFile.B9Extras+import Test.QuickCheck (Arbitrary(arbitrary))+import qualified Test.QuickCheck as QuickCheck  -- | Available capabilities for Linux containers. This maps directly to the -- capabilities defined in 'man 7 capabilities'.@@ -48,7 +50,12 @@   | CAP_SYS_TTY_CONFIG   | CAP_SYSLOG   | CAP_WAKE_ALARM-  deriving (Read, Show, Eq)+  deriving (Read, Show, Eq, Enum, Bounded)++instance Arbitrary ContainerCapability where +  arbitrary = +    QuickCheck.elements +      (enumFromTo minBound maxBound :: [ContainerCapability])  containerCapabilitiesK :: String containerCapabilitiesK = "guest_capabilities"

@@ -16,6 +16,8 @@ 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@@ -27,6 +29,16 @@         guestRamSize :: RamSize       }   deriving (Read, Show, Eq)++instance Arbitrary LibVirtLXCConfig where+  arbitrary = +    LibVirtLXCConfig <$>+    smaller arbitrary <*>+    smaller (oneof [pure Nothing, Just <$> arbitraryFilePath]) <*>+    smaller arbitraryFilePath <*>+    smaller (oneof [pure Nothing, Just <$> listOf1 arbitraryLetter]) <*>+    smaller arbitrary <*>+    pure (RamSize 4 GB)  makeLenses ''LibVirtLXCConfig 

@@ -12,7 +12,9 @@  import Data.ConfigFile.B9Extras import Data.Data-import Data.List (isSuffixOf)+import Data.List (isSuffixOf, sort)+import Test.QuickCheck (Positive(..), Arbitrary(arbitrary), listOf1)+import B9.QCUtil (smaller, arbitraryFilePath, arbitraryLetter)  newtype RepoCache = RepoCache FilePath   deriving (Read, Show, Typeable, Data)@@ -24,20 +26,41 @@       SshPrivKey       SshRemoteHost       SshRemoteUser-  deriving (Read, Show, Typeable, Data, Eq)+  deriving (Read, Show, Typeable, Data, Eq, Ord) +instance Arbitrary RemoteRepo where +  arbitrary = RemoteRepo <$>+    smaller (listOf1 arbitraryLetter) <*>+    smaller arbitraryFilePath <*> +    smaller arbitrary <*>+    smaller arbitrary <*>+    smaller arbitrary ++ remoteRepoRepoId :: RemoteRepo -> String remoteRepoRepoId (RemoteRepo repoId _ _ _ _) = repoId  newtype SshPrivKey = SshPrivKey FilePath-  deriving (Read, Show, Typeable, Data, Eq)+  deriving (Read, Show, Typeable, Data, Eq, Ord) +instance Arbitrary SshPrivKey where +  arbitrary = SshPrivKey <$> arbitraryFilePath+ newtype SshRemoteHost = SshRemoteHost (String, Int)-  deriving (Read, Show, Typeable, Data, Eq)+  deriving (Read, Show, Typeable, Data, Eq, Ord) +instance Arbitrary SshRemoteHost where +  arbitrary = do +    h <- smaller (listOf1 arbitraryLetter)+    Positive p <- arbitrary+    pure (SshRemoteHost (h,p))+ newtype SshRemoteUser = SshRemoteUser String-  deriving (Read, Show, Typeable, Data, Eq)+  deriving (Read, Show, Typeable, Data, Eq, Ord) +instance Arbitrary SshRemoteUser where +  arbitrary = SshRemoteUser <$> smaller (listOf1 arbitraryLetter)+ -- | Persist a repo to a configuration file. remoteRepoToCPDocument :: RemoteRepo -> CPDocument -> Either CPError CPDocument remoteRepoToCPDocument repo cpIn = cpWithRepo@@ -56,7 +79,7 @@ -- | Load a repository from a configuration file that has been written by -- 'writeRepositoryToB9Config'. parseRemoteRepos :: CPDocument -> Either CPError [RemoteRepo]-parseRemoteRepos cp = traverse parseRepoSection repoSections+parseRemoteRepos cp = sort <$> traverse parseRepoSection repoSections   where     repoSections = filter (repoSectionSuffix `isSuffixOf`) (sectionsCP cp)     parseRepoSection section = parseResult

@@ -19,6 +19,9 @@ 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@@ -32,6 +35,16 @@       }   deriving (Read, Show, Eq) +instance Arbitrary SystemdNspawnConfig where +  arbitrary = +    SystemdNspawnConfig +    <$> smaller arbitrary +    <*> smaller arbitrary +    <*> smaller arbitrary+    <*> smaller arbitrary+    <*> smaller (QuickCheck.oneof [pure Nothing, Just <$> arbitraryFilePath])+    <*> smaller arbitrary+ data SystemdNspawnConsole   = SystemdNspawnInteractive   | SystemdNspawnReadOnly@@ -39,6 +52,15 @@   | SystemdNspawnPipe   deriving (Eq) +instance Arbitrary SystemdNspawnConsole where+  arbitrary = +    QuickCheck.elements +      [ SystemdNspawnInteractive+      , SystemdNspawnReadOnly+      , SystemdNspawnPassive+      , SystemdNspawnPipe+      ]+           instance Show SystemdNspawnConsole where   show x = case x of     SystemdNspawnInteractive -> "interactive"@@ -62,7 +84,7 @@         return SystemdNspawnPassive       +++ do         Ident "pipe" <- lexP-        return SystemdNspawnReadOnly+        return SystemdNspawnPipe  makeLenses ''SystemdNspawnConfig 

@@ -3,6 +3,7 @@ -- @since 0.5.65 module B9.B9Exec   ( cmd,+    cmdInteractive,     hostCmdEither,     hostCmd,     hostCmdStdIn,@@ -14,8 +15,7 @@ import B9.B9Config import B9.B9Error import B9.B9Logging--- import qualified Data.ByteString.Lazy as Lazy-+import B9.BuildInfo (BuildInfoReader, isInteractive) import qualified Conduit as CL import Control.Concurrent import Control.Concurrent.Async (Concurrently (..), race)@@ -51,18 +51,40 @@ -- If the command exists with non-zero exit code, the current process exists with the same -- exit code. ----- @since 0.5.65-cmd ::-  (HasCallStack, Member ExcB9 e, CommandIO e) =>+-- @since 2.0.0+cmdInteractive ::+  (HasCallStack, Member ExcB9 e, Member BuildInfoReader e, CommandIO e) =>   String ->   Eff e ()-cmd str = do+cmdInteractive str = do   t <- view defaultTimeout <$> getB9Config   inheritStdIn <- isInteractive   ok <-     if inheritStdIn       then hostCmdEither HostCommandInheritStdin str t       else hostCmdEither HostCommandNoStdin str t+  case ok of+    Right _ ->+      return ()+    Left e ->+      errorExitL ("SYSTEM COMMAND FAILED: " ++ show e)++-- | Execute the given shell command.+--+-- The command and the output is either logged to the logfile with 'traceL' or 'errorL' or+-- written to stdout.+--+-- If the command exists with non-zero exit code, the current process exists with the same+-- exit code.+--+-- @since 0.5.65+cmd ::+  (HasCallStack, Member ExcB9 e, CommandIO e) =>+  String ->+  Eff e ()+cmd str = do+  t <- view defaultTimeout <$> getB9Config+  ok <- hostCmdEither HostCommandNoStdin str t   case ok of     Right _ ->       return ()

@@ -1,5 +1,6 @@ module B9.B9Monad   ( runB9,+    runB9Interactive,     B9,     B9Eff,     IsB9,@@ -53,7 +54,21 @@ -- -- @since 0.5.65 runB9 :: HasCallStack => B9 a -> B9ConfigAction a-runB9 action = do+runB9 = runB9Full False++-- | Execute a 'B9' effect like 'runB9' but run +-- external commands, such as `systemd-nspawn`, +-- /interactively/.+--+-- When run /interactively/, the stdin/stdout of +-- certain commands is inherited from the main process.+--+-- @since 2.0.0+runB9Interactive :: HasCallStack => B9 a -> B9ConfigAction a+runB9Interactive = runB9Full True++runB9Full :: HasCallStack => Bool -> B9 a -> B9ConfigAction a+runB9Full interactive action = do   cfg <- getB9Config   env <- askEnvironment   lift@@ -62,8 +77,11 @@         . runEnvironmentReader env         . runB9ConfigReader cfg         . withLogger-        . withBuildInfo+        . withBuildInfo interactive         . withRemoteRepos         . withSelectedRemoteRepo         $ action     )++    +    

@@ -10,6 +10,7 @@     getBuildDir,     withBuildInfo,     BuildInfoReader,+    isInteractive,   ) where @@ -45,7 +46,8 @@       { bsBuildId :: String,         bsBuildDate :: String,         bsBuildDir :: FilePath,-        bsStartTime :: UTCTime+        bsStartTime :: UTCTime,+        bsIsInteractive :: Bool       }   deriving (Eq, Show) @@ -74,9 +76,10 @@     Member LoggerReader e,     HasCallStack   ) =>+  Bool ->   Eff (BuildInfoReader ': e) a ->   Eff e a-withBuildInfo action = withRootDir $ do+withBuildInfo interactive action = withRootDir $ do   now <- lift getCurrentTime   let buildDate = formatTime undefined "%F-%T" now -- TODO make configurable how the build date is formatted   buildId <- generateBuildId @@ -117,7 +120,7 @@           when (_uniqueBuildDirs cfg && not (_keepTempDirs cfg)) $             removeDirectoryRecursive buildDir     runImpl buildId buildDate startTime buildDir =-      let ctx = BuildInfo buildId buildDate buildDir startTime+      let ctx = BuildInfo buildId buildDate buildDir startTime interactive        in runReader ctx wrappedAction       where         wrappedAction = do@@ -140,3 +143,10 @@  getBuildDir :: Member BuildInfoReader e => Eff e FilePath getBuildDir = bsBuildDir <$> ask++-- | Ask whether @stdin@ of the @B9@ process should be redirected to the+-- external commands executed during the build.+--+-- @since 2.0.0+isInteractive :: Member BuildInfoReader e => Eff e Bool+isInteractive = bsIsInteractive <$> ask

@@ -78,9 +78,9 @@ successMarkerFile :: [Char] successMarkerFile = "SUCCESS" -execute :: (Member ExcB9 e, CommandIO e, Member B9ConfigReader e) => Context -> Eff e Bool+execute :: (Member ExcB9 e, CommandIO e, Member BuildInfoReader e, Member B9ConfigReader e) => Context -> Eff e Bool execute (Context scriptDirHost _uuid domainFile cfg) = do-  cmd $ printf "%s create '%s' --console --autodestroy" virshCommand domainFile+  cmdInteractive $ printf "%s create '%s' --console --autodestroy" virshCommand domainFile   -- cmd $ printf "%s console %U" virsh uuid   liftIO (doesFileExist $ scriptDirHost </> successMarkerFile)   where

@@ -148,10 +148,11 @@ localRepoDir (RepoCache cacheDir) = cacheDir </> "local-repo"  -- | Select the first 'RemoteRepo' with a given @repoId@.-lookupRemoteRepo :: [RemoteRepo] -> String -> Maybe RemoteRepo-lookupRemoteRepo repos repoId = lookup repoId repoIdRepoPairs+lookupRemoteRepo :: Set RemoteRepo -> String -> Maybe RemoteRepo+lookupRemoteRepo repos repoId = Map.lookup repoId repoIdRepoPairs   where-    repoIdRepoPairs = map (\r@(RemoteRepo rid _ _ _ _) -> (rid, r)) repos+    repoIdRepoPairs = +      Map.fromList (map (\r@(RemoteRepo rid _ _ _ _) -> (rid, r)) (toList repos))  -- | A 'Map' that maps 'Repository's to the 'SharedImage's they hold. --

@@ -64,7 +64,7 @@   repoCache <-     lift       (initRepoCache (fromMaybe defaultRepositoryCache (_repositoryCache cfg)))-  remoteRepos' <- mapM (initRemoteRepo repoCache) (_remoteRepos cfg)+  remoteRepos' <- Set.fromList <$> mapM (initRemoteRepo repoCache) (toList (_remoteRepos cfg))   let setRemoteRepos = remoteRepos .~ remoteRepos'   localB9Config setRemoteRepos (runReader repoCache f) @@ -123,7 +123,7 @@ repoSearch subDir glob = (:) <$> localMatches <*> remoteRepoMatches   where     remoteRepoMatches =-      getRemoteRepos >>= mapM remoteRepoSearch+      getRemoteRepos >>= mapM remoteRepoSearch . toList     localMatches :: Eff e (Repository, [FilePath])     localMatches = do       cache <- getRepoCache@@ -295,8 +295,8 @@ pullLatestImage name@(SharedImageName dbgName) = do   repos <- getSelectedRepos   let repoPredicate Cache = False-      repoPredicate (Remote repoId) = repoId `elem` repoIds-      repoIds = map remoteRepoRepoId repos+      repoPredicate (Remote repoId) = repoId `Set.member` repoIds+      repoIds = Set.map remoteRepoRepoId repos       hasName sharedImage = name == sharedImageName sharedImage   candidates <-     filterRepoImagesMap repoPredicate hasName <$> getSharedImages@@ -434,11 +434,11 @@     pushToRepo (fromJust r) cachedInfoFile repoInfoFile  -- | Return either all remote repos or just the single selected repo.-getSelectedRepos :: '[B9ConfigReader, SelectedRemoteRepoReader] <:: e => Eff e [RemoteRepo]+getSelectedRepos :: '[B9ConfigReader, SelectedRemoteRepoReader] <:: e => Eff e (Set RemoteRepo) getSelectedRepos = do   allRepos <- getRemoteRepos   MkSelectedRemoteRepo selectedRepo <- getSelectedRemoteRepo-  let repos = maybe allRepos return selectedRepo -- 'Maybe' a repo+  let repos = maybe allRepos Set.singleton selectedRepo -- 'Maybe' a repo   return repos  -- | Return the path to the sub directory in the cache that contains files of

@@ -163,7 +163,7 @@   deriving (Show)  execBuild ::-  (Member ExcB9 e, CommandIO e) =>+  (Member ExcB9 e, Member BuildInfoReader e, CommandIO e) =>   SudoPrepender ->   ContainerMounts ->   [SharedDirectory] ->@@ -214,10 +214,18 @@       execOptions = ["/bin/sh", bootScriptContainerCommand bootScript]       timeout = (TimeoutMicros . (* 1000000)) <$> _systemdNspawnMaxLifetimeSeconds dCfg   traceL ("executing systemd-nspawn container build")-  case _systemdNspawnConsole dCfg of-    SystemdNspawnInteractive ->+  interactiveAction <- isInteractive+  let +    runInteractively =+      case _systemdNspawnConsole dCfg of+        SystemdNspawnInteractive ->+          True+        _ ->+          interactiveAction+  if runInteractively +    then       hostCmdStdIn HostCommandInheritStdin (sudo systemdCmd) Nothing-    _ ->+    else         hostCmd (sudo systemdCmd) timeout  umountLoopbackImages ::

@@ -0,0 +1,116 @@+{-# LANGUAGE NumericUnderscores #-}+{-# LANGUAGE QuasiQuotes #-}++module B9.B9ConfigSpec+  ( spec,+  )+where++import Data.Maybe (fromMaybe)+import Control.Lens ((^.))+import B9.B9Config+import B9.B9Monad+import Control.Exception+import Control.Monad+import System.Directory+import System.Environment+import System.FilePath+import System.IO.B9Extras+import Test.Hspec(Spec, it, shouldBe, HasCallStack, describe)+import Test.QuickCheck (property, (===), (==>))+import Text.Printf+import qualified Data.Text as Text+import Data.ConfigFile.B9Extras+  ( +    CPError+  )+import NeatInterpolation as Neat  +import Data.Either (isRight)++spec :: HasCallStack => Spec+spec = do+  it "forall valid configs: parse . render == id" $ property $+    \cfg -> +      let actual = renderThenParseB9Config cfg +      in isRight actual ==> (Right cfg === actual)+  +  describe "parse textual configuration" $ do  +    let +      exampleConfig = Text.unpack [Neat.text|+          [global]+          build_dir_root: Nothing+          keep_temp_dirs: False+          log_file: Nothing+          max_cached_shared_images: Just 2+          repository: Nothing+          repository_cache: Just (InB9UserDir "repo-cache")+          unique_build_dirs: True+          verbosity: Just LogNothing+          timeout_factor: 3+          default_timeout_seconds: 10+        |] +    it "correctly parses verbosity" $ do+      cfg <- withConfig exampleConfig getB9Config+      _verbosity cfg `shouldBe` Just LogNothing++    it "correctly parses timeout_factor" $ do+      cfg <- withConfig exampleConfig getB9Config+      _timeoutFactor cfg `shouldBe` Just 3++    it "correctly parses default_timeout" $ do+      cfg <- withConfig exampleConfig getB9Config+      _defaultTimeout cfg `shouldBe` Just (TimeoutMicros 10_000_000)++renderThenParseB9Config :: B9Config -> Either CPError B9Config+renderThenParseB9Config = b9ConfigToCPDocument >=> parseB9Config++withConfig :: String -> B9 a -> IO a+withConfig cfgFileContents testAction = +  withTempBuildDirs $ \cfg -> do+    let cfgFileName = +          fromMaybe +            (error "Internal Error")+            (cfg ^. customDefaulB9ConfigPath)+    cfgFilePath <- resolve cfgFileName +    writeFile cfgFilePath cfgFileContents+    runB9ConfigActionWithOverrides (runB9 testAction) cfg++withTempBuildDirs :: HasCallStack => (B9ConfigOverride -> IO a) -> IO a+withTempBuildDirs k =+  bracket acquire release use+  where+    acquire = do+      nixOutDirEnv <- lookupEnv "NIX_BUILD_TOP"+      let rootDir = maybe InTempDir (((.) . (.)) Path (</>)) nixOutDirEnv+      repoRelPath <- printf "testsRepositoryIOSpec-test-repo-%U" <$> randomUUID+      buildRelPath <- printf "RepositoryIOSpec-root-%U" <$> randomUUID+      cfgRelPath <- printf "RepositoryIOSpec-b9cfg-%U" <$> randomUUID+      let tmpRepoPath = rootDir ("tests" </> repoRelPath)+          tmpBuildPath = rootDir ("tests" </> buildRelPath)+          tmpCfgPath = rootDir ("tests" </> cfgRelPath)+      ensureSystemPath tmpRepoPath+      ensureSystemPath tmpBuildPath+      tmpBuildPathFileName <- resolve tmpBuildPath+      return (tmpRepoPath, tmpBuildPathFileName, tmpCfgPath)+    release (tmpRepoPath, tmpBuildPathFileName, tmpCfgPath) = do+      let cleanupTmpPath = removePathForcibly <=< resolve+      cleanupTmpPath tmpRepoPath+      cleanupTmpPath tmpCfgPath+      removePathForcibly tmpBuildPathFileName+    use (tmpRepoPath, tmpBuildPathFileName, tmpCfgPath) =+      let mkCfg cfgIn =+            cfgIn+              { _repositoryCache = Just tmpRepoPath,+                _projectRoot = Just tmpBuildPathFileName+              }+          oCfg =+            overrideB9Config+              mkCfg+              ( overrideWorkingDirectory+                  tmpBuildPathFileName+                  ( overrideDefaultB9ConfigPath+                      tmpCfgPath+                      noB9ConfigOverride+                  )+              )+       in k oCfg