diff --git a/.git/modules/hub/HEAD b/.git/modules/hub/HEAD
--- a/.git/modules/hub/HEAD
+++ b/.git/modules/hub/HEAD
@@ -1,1 +1,1 @@
-0cb06f35180a047ec98c30fb5fc14da7ea39cfc1
+93ea716e709fd3eff049d49d11ee45cac51cadfc
diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,16 @@
# Changelog
+## 0.3.0 (next)
+
+## 0.2.0 (2022-07-26)
+
+- restrict ssh capability to the agent socket.
+- home volume is set to the namespace name if a namespace is defined.
+- allow passing args directly to a command: `podenv nix:github:podenv/devenv#emacs --version`
+- fix syscaps argument for bwrap.
+- use system chcon to set label.
+- add --manifest argument to show every configuration context.
+
## 0.1.0 (2022-05-02)
- Initial release
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -1,5 +1,8 @@
# podenv: a container wrapper
+[](https://hackage.haskell.org/package/podenv)
+[](LICENSE)
+
> Note that this is a work in progress, please get in touch if you are interested.
Podenv provides a declarative interface to manage containerized applications.
@@ -38,12 +41,12 @@
- `--volume web:~` use a volume named `web` for the container home.
- `--hostfile ./document.pdf` share a single file.
-### Runtimes
+### Container Runtimes
-Podenv works with multiple runtimes:
+Podenv works with multiple container runtimes:
-- Podman for container image and Containerfile.
-- Bubblewrap for local rootfs and Nix Flakes. Checkout the [Howto use Nix tutorial](./docs/tutorials/nix.md).
+- Podman for image and Containerfile.
+- Bubblewrap for local rootfs and Nix Flakes.
The runtime integration is decoupled from the application description
so that more options can be added in the future.
@@ -61,12 +64,12 @@
#### Firefox with a fedora container
```dhall
-Application::{
+(env:PODENV).Application::{
, name = "firefox"
, description = Some "Mozilla Firefox"
-, runtime = (./fedora.dhall).latest.useGraphic [ "firefox" ]
+, runtime = (env:PODENV).Hub.fedora.useGraphic [ "firefox" ]
, command = [ "firefox", "--no-remote" ]
-, capabilities = Capabilities::{ wayland = True, network = True }
+, capabilities = (env:PODENV).Capabilities::{ wayland = True, network = True }
}
```
@@ -74,11 +77,10 @@
```dhall
\(pkgs : List Text) ->
-ContainerBuild::{
+(env:PODENV).ContainerBuild::{
, containerfile =
''
FROM fedora:latest
- RUN ${./mkUser.dhall "fedora"}
RUN dnf install -y mesa-dri-drivers pipewire-libs
RUN dnf update -y
RUN dnf install -y ${concatSep " " pkgs}
@@ -95,11 +97,11 @@
Podenv support the [Nix installables syntax](https://nixos.org/manual/nix/stable/command-ref/new-cli/nix.html#installables):
```dhall
-Application::{
+(env:PODENV).Application::{
, name = "polyglot"
, description = Some "Tool to count lines of source code."
-, runtime = Nix Flakes::{ installables = [ "github:podenv/polyglot.nix" ]}
-, capabilities = Capabilities::{ cwd = True }
+, runtime = (env:PODENV).Hub.nix.useInstallables [ "github:podenv/polyglot.nix" ]
+, capabilities = (env:PODENV).Capabilities::{ cwd = True }
}
```
@@ -112,53 +114,7 @@
## Usage
Podenv provides a simple command line: `podenv [--caps] application-name [args]`.
-
-Here are some common use cases:
-
-### Applications
-
-```ShellSession
-$ podenv gimp ./image.png
-```
-
-… runs the following command: `podman run [wayland args] --volume $(pwd)/image.png:/data/image.png localhost/gimp /data/image.png`
-
-If necessary, podenv builds a local image using the Containerfile defined by the application.
-
-### Container image
-
-```ShellSession
-$ podenv --rw --network --root --cwd --shell image:ubi8
-```
-
-… runs the following command: `podman run --rm -it --detach-keys '' --volume $(pwd):/data:Z --workdir /data --volume ~/.local/share/podenv/volumes/image-ubi8-home:/root ubi8 /bin/bash`
-
-By default podenv mounts a local volumes for the home directory.
-
-### Bubblewrap chroot
-
-Extract a container image and execute it with bubblewrap:
-
-```ShellSession
-$ podenv --volume rawhide:/mnt image:fedora:rawhide bash -c "tar --one-file-system -cf - / | tar -C /mnt -xf -"
-$ podenv --network --rw --root rootfs:rawhide
-```
-
-… extracts the rootfs with: `podman run --rm --read-only=true --network none --volume ~/.local/share/podenv/volumes/rawhide:/mnt fedora:rawhide bash -c "tar ..."`
-
-… and, runs the following command: `bwrap [unshare args] --bind ~/.local/share/podenv/volumes/rawhide / --bind ~/.local/share/podenv/volumes/rootfs-7e08b7-home /root /bin/sh`
-
-This is useful to avoid polluting the container storage.
-
-### Nix flakes
-
-```ShellSession
-$ podenv nixpkgs#hello
-```
-
-… runs the installable using bubblewrap: `bwrap [unshare args] --bind ~/.local/share/podenv/volumes/nix-store /nix --bind ~/.local/share/podenv/volumes/nix-cache ~/.cache/nix --clearenv --setenv NIX_SSL_CERT_FILE /etc/pki/tls/certs/ca-bundle.crt nix --extra-experimental-features "nix-command flakes" run nixpkgs#hello`
-
-If necessary, podenv automatically installs the Nix toolchain using bubblewrap with the [nix.setup application](https://github.com/podenv/hub/blob/main/Builders/nix.dhall).
+Checkout the tutorials for examples.
# Documentation
@@ -175,6 +131,7 @@
* [Use an application](./docs/tutorials/use.md)
* [Create an application](./docs/tutorials/create.md)
* [Howto use Nix](./docs/tutorials/nix.md)
+* [Work with rawhide](./docs/tutorials/rawhide.md)
## Howtos
diff --git a/hub/Applications/chroot.dhall b/hub/Applications/chroot.dhall
new file mode 100644
--- /dev/null
+++ b/hub/Applications/chroot.dhall
@@ -0,0 +1,16 @@
+let Podenv = ../Podenv.dhall
+
+in \(rootfs : Text) ->
+ Podenv.Application::{
+ , description = Some "Start a privileged shell with a rootfs"
+ , runtime = Podenv.Rootfs rootfs
+ , syscaps = [ "CHOWN", "DAC_OVERRIDE" ]
+ , command = [ "bash", "--rcfile", "/etc/profile" ]
+ , capabilities = Podenv.Capabilities::{
+ , terminal = True
+ , interactive = True
+ , network = True
+ , rw = True
+ , root = True
+ }
+ }
diff --git a/hub/Applications/gscan2pdf.dhall b/hub/Applications/gscan2pdf.dhall
new file mode 100644
--- /dev/null
+++ b/hub/Applications/gscan2pdf.dhall
@@ -0,0 +1,3 @@
+./_graphicEditor.dhall
+ "gscan2pdf"
+ "GUI for producing a multipage PDF from a scan"
diff --git a/hub/Applications/package.dhall b/hub/Applications/package.dhall
--- a/hub/Applications/package.dhall
+++ b/hub/Applications/package.dhall
@@ -1,5 +1,6 @@
{ audacity = ./audacity.dhall
, ardour = ./ardour.dhall
+, chroot = ./chroot.dhall
, blender = ./blender.dhall
, brave = ./brave.dhall
, centos = ./centos.dhall
@@ -14,6 +15,7 @@
, ffmpeg = ./ffmpeg.dhall
, gimp = ./gimp.dhall
, google-chrome = ./google-chrome.dhall
+, gscan2pdf = ./gscan2pdf.dhall
, gworldclock = ./gworldclock.dhall
, hydrogen = ./hydrogen.dhall
, inkscape = ./inkscape.dhall
diff --git a/hub/Builders/debian.dhall b/hub/Builders/debian.dhall
--- a/hub/Builders/debian.dhall
+++ b/hub/Builders/debian.dhall
@@ -17,6 +17,7 @@
RUN ${./mkUser.dhall "debian"}
RUN apt-get update
RUN apt-get install -y ${Prelude.Text.concatSep " " pkgs}
+ ENV USER=debian
''
, image_volumes = mkVolumes ver
, image_home = Some "/home/debian"
diff --git a/hub/Builders/fedora.dhall b/hub/Builders/fedora.dhall
--- a/hub/Builders/fedora.dhall
+++ b/hub/Builders/fedora.dhall
@@ -20,6 +20,7 @@
${pre-task}
RUN dnf update -y
RUN dnf install -y ${Prelude.Text.concatSep " " pkgs}
+ ENV USER=fedora
''
, image_volumes = mkVolumes ver
, image_home = Some "/home/fedora"
diff --git a/hub/Builders/nix.dhall b/hub/Builders/nix.dhall
--- a/hub/Builders/nix.dhall
+++ b/hub/Builders/nix.dhall
@@ -32,9 +32,9 @@
, "/tmp/nix-${version}-x86_64-linux/install"
, "rm -r /tmp/nix-*-x86_64-linux*"
, "cp -P /nix/var/nix/profiles/per-user/\$(id -nu)/profile-1-link /nix/var/nix/profiles/nix-install"
- , "/nix/var/nix/profiles/default/bin/nix-collect-garbage --delete-old"
- , "/nix/var/nix/profiles/default/bin/nix-store --optimise"
- , "/nix/var/nix/profiles/default/bin/nix-store --verify --check-contents"
+ , "/nix/var/nix/profiles/nix-install/bin/nix-collect-garbage --delete-old"
+ , "/nix/var/nix/profiles/nix-install/bin/nix-store --optimise"
+ , "/nix/var/nix/profiles/nix-install/bin/nix-store --verify --check-contents"
]
, "); test -f ~/.config/nix/nix.conf || ("
, "echo -en ${Text/show default-config} > ~/.config/nix/nix.conf"
diff --git a/podenv.cabal b/podenv.cabal
--- a/podenv.cabal
+++ b/podenv.cabal
@@ -1,6 +1,6 @@
cabal-version: 3.0
name: podenv
-version: 0.1.0
+version: 0.2.0
synopsis: A container wrapper
description:
Podenv provides a declarative interface to manage containerized applications.
@@ -63,7 +63,7 @@
, gitrev
, lens-family-core
, lens-family-th
- , linux-capabilities
+ , linux-capabilities >= 0.1.1.0
, optparse-applicative
, relude >= 0.7
, text
@@ -81,6 +81,7 @@
, Podenv.Prelude
, Podenv.Runtime
, Podenv.Version
+ , Podenv
other-modules: Paths_podenv
autogen-modules: Paths_podenv
diff --git a/src/Podenv.hs b/src/Podenv.hs
new file mode 100644
--- /dev/null
+++ b/src/Podenv.hs
@@ -0,0 +1,36 @@
+-- | The podenv library entry point
+module Podenv
+ ( -- * Config
+ Application (..),
+ Capabilities (..),
+
+ -- * Import
+ loadConfig,
+ decodeExpr,
+ select,
+
+ -- * Context
+ appToContext,
+
+ -- * Runtime
+ RuntimeEnv (..),
+ defaultRuntimeEnv,
+ execute,
+ getPodmanPodStatus,
+ deletePodmanPod,
+ )
+where
+
+import Podenv.Application
+import Podenv.Config
+import Podenv.Context
+import Podenv.Dhall
+import Podenv.Env
+import Podenv.Prelude
+import Podenv.Runtime
+
+appToContext :: AppEnv -> Application -> Name -> IO Context
+appToContext = preparePure Regular
+
+loadConfig :: Text -> IO Config
+loadConfig = Podenv.Config.load Nothing . Just
diff --git a/src/Podenv/Application.hs b/src/Podenv/Application.hs
--- a/src/Podenv/Application.hs
+++ b/src/Podenv/Application.hs
@@ -1,5 +1,6 @@
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
@@ -21,27 +22,27 @@
)
where
-import qualified Data.Map
-import qualified Data.Text as Text
-import qualified Data.Text.IO as Text
-import qualified Podenv.Build
+import Data.Map qualified
+import Data.Set qualified as Set
+import Data.Text qualified as Text
+import Podenv.Build qualified
import Podenv.Dhall
import Podenv.Env
import Podenv.Prelude
-import qualified Podenv.Runtime as Ctx
-import qualified System.Posix.Files
+import Podenv.Runtime qualified as Ctx
+import System.Posix.Files qualified
data Mode = Regular | Shell
-- | Converts an Application into a Context
-prepare :: Application -> Mode -> Ctx.Name -> IO Ctx.Context
-prepare app mode ctxName = do
+prepare :: Mode -> Application -> Ctx.Name -> IO Ctx.Context
+prepare mode app ctxName = do
appEnv <- Podenv.Env.new
- preparePure appEnv app mode ctxName
+ preparePure mode appEnv app ctxName
-- TODO: make this stricly pure using a PodenvMonad similar to the PandocMonad
-preparePure :: AppEnv -> Application -> Mode -> Ctx.Name -> IO Ctx.Context
-preparePure envBase app mode ctxName = do
+preparePure :: Mode -> AppEnv -> Application -> Ctx.Name -> IO Ctx.Context
+preparePure mode envBase app ctxName = do
home <- getContainerHome
runReaderT (doPrepare app mode ctxName home) (appEnv home)
where
@@ -91,7 +92,9 @@
modifiers = disableSelinux . setRunAs . addSysCaps . addEnvs . setEnv . ensureWorkdir . ensureHome
ensureHome = case appHome of
- Just fp -> Ctx.addMount (toString fp) (Ctx.MkVolume Ctx.RW (Ctx.Volume $ (Ctx.unName ctxName <> "-home")))
+ Just fp ->
+ let volumeName = fromMaybe (Ctx.unName ctxName) (app ^. appNamespace)
+ in Ctx.addMount (toString fp) (Ctx.MkVolume Ctx.RW (Ctx.Volume $ volumeName <> "-home"))
Nothing -> id
-- Check if path is part of a mount point
@@ -132,7 +135,7 @@
addSysCap :: Text -> Ctx.Context -> Ctx.Context
addSysCap syscap = case readMaybe (toString $ "CAP_" <> syscap) of
Nothing -> error $ "Can't read syscap: " <> show syscap
- Just c -> Ctx.syscaps %~ (c :)
+ Just c -> Ctx.syscaps %~ (Set.insert c)
addEnvs ctx = foldr addEnv ctx (app ^. appEnviron)
addEnv :: Text -> Ctx.Context -> Ctx.Context
@@ -298,33 +301,10 @@
Nothing -> id
Just path -> Ctx.addEnv (toText var) (toText path) . Ctx.directMount (takeDirectory path)
-setSshControlPath :: AppEnvT (Ctx.Context -> Ctx.Context)
-setSshControlPath = do
- config <- readConfig
- uid <- asks _hostUid
- pure $ case getControlPath (words config) of
- Just cp ->
- case takeDirectory $ toString $ Text.replace "%i" (show uid) cp of
- "/tmp" -> id
- d -> Ctx.directMount d
- Nothing -> id
- where
- readConfig = do
- homeDir <- fromMaybe (error "Need HOME for ssh") <$> asks _hostHomeDir
- let configPath = homeDir ".ssh" "config"
- exist <- liftIO $ doesFileExist configPath
- bool (pure "") (liftIO $ Text.readFile configPath) exist
- getControlPath = \case
- ("ControlPath" : x : _) -> Just x
- (_ : xs) -> getControlPath xs
- [] -> Nothing
-
setSsh :: Ctx.Context -> AppEnvT Ctx.Context
setSsh ctx = do
- shareConfig <- mountHomeConfig "ssh" ".ssh"
shareAgent <- liftIO $ setAgent "SSH_AUTH_SOCK"
- shareControlPath <- setSshControlPath
- pure $ ctx & shareAgent . shareConfig . shareControlPath
+ pure $ ctx & shareAgent
setGpg :: Ctx.Context -> AppEnvT Ctx.Context
setGpg ctx = do
diff --git a/src/Podenv/Build.hs b/src/Podenv/Build.hs
--- a/src/Podenv/Build.hs
+++ b/src/Podenv/Build.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}
@@ -11,18 +12,18 @@
)
where
-import qualified Control.Monad
-import qualified Data.Digest.Pure.SHA as SHA
-import qualified Data.Text as Text
-import qualified Data.Text.IO as Text
-import qualified Podenv.Config
+import Control.Monad qualified
+import Data.Digest.Pure.SHA qualified as SHA
+import Data.Text qualified as Text
+import Data.Text.IO qualified as Text
+import Podenv.Config qualified
import Podenv.Dhall
import Podenv.Prelude
import Podenv.Runtime (ImageName (..))
-import qualified Podenv.Runtime
+import Podenv.Runtime qualified
import System.Directory (doesDirectoryExist, renameFile)
import System.Exit (ExitCode (ExitSuccess))
-import qualified System.Process.Typed as P
+import System.Process.Typed qualified as P
-- | Helper function to run a standalone app, usefull for local build
type AppRunner = Application -> IO ()
@@ -45,10 +46,12 @@
-- | Create the build env
prepare :: Podenv.Runtime.RuntimeEnv -> Application -> IO (BuildEnv, Application)
prepare re app = case runtime app of
- Image name -> pure (defaultBuildEnv name, app)
- Container cb -> pure (prepareContainer cb, app)
- Rootfs fp -> pure (defaultBuildEnv fp, app)
+ Image name -> pure (defaultBuildEnv name, addArgs app)
+ Container cb -> pure (prepareContainer cb, addArgs app)
+ Rootfs fp -> pure (defaultBuildEnv fp, addArgs app)
Nix expr -> prepareNix re app expr
+ where
+ addArgs = appCommand %~ (<> Podenv.Runtime.extraArgs re)
containerBuildRuntime :: ContainerBuild -> Podenv.Runtime.RuntimeContext
containerBuildRuntime = Podenv.Runtime.Container . mkImageName
@@ -93,8 +96,14 @@
nixRuntime = Podenv.Runtime.Bubblewrap "/"
getCertLocation :: IO (Maybe FilePath)
-getCertLocation = runMaybeT $ Control.Monad.msum $ checkPath <$> paths
+getCertLocation = runMaybeT $ Control.Monad.msum $ [checkEnv] <> (checkPath <$> paths)
where
+ checkEnv :: MaybeT IO FilePath
+ checkEnv = do
+ env <- lift $ lookupEnv "NIX_SSL_CERT_FILE"
+ case env of
+ Just fp -> checkPath fp
+ Nothing -> mzero
checkPath :: FilePath -> MaybeT IO FilePath
checkPath fp = do
exist <- lift $ doesPathExist fp
@@ -178,10 +187,13 @@
runCommand =
[toText nixCommandPath] <> nixFlags <> case app ^. appCommand of
- [] -> ["run"] <> nixArgs
- appArgs -> ["shell"] <> nixArgs <> ["--command"] <> appArgs
+ [] ->
+ ["run"] <> nixArgs <> case Podenv.Runtime.extraArgs re of
+ [] -> []
+ xs -> ["--"] <> xs
+ appArgs -> ["shell"] <> nixArgs <> ["--command"] <> appArgs <> Podenv.Runtime.extraArgs re
addCommand = appCommand .~ runCommand
- addVolumes = appVolumes %~ mappend ["nix-store:/nix", "nix-cache:~/.cache/nix"]
+ addVolumes = appVolumes %~ mappend ["nix-store:/nix", "nix-cache:~/.cache/nix", "nix-config:~/.config/nix"]
addEnvirons certs =
appEnviron
%~ mappend
diff --git a/src/Podenv/Config.hs b/src/Podenv/Config.hs
--- a/src/Podenv/Config.hs
+++ b/src/Podenv/Config.hs
@@ -1,10 +1,12 @@
{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
-- | This module contains the logic to load the dhall configuration
module Podenv.Config
( load,
+ decodeExpr,
select,
Config (..),
Atom (..),
@@ -18,23 +20,23 @@
where
import Control.Exception (bracket_)
-import qualified Data.Digest.Pure.SHA as SHA
+import Data.Digest.Pure.SHA qualified as SHA
import Data.Either.Validation
-import qualified Data.Text as Text
-import qualified Data.Text.IO as Text (readFile)
-import qualified Dhall
-import qualified Dhall.Core as Dhall
-import qualified Dhall.Import
-import qualified Dhall.Map as DM
+import Data.Text qualified as Text
+import Data.Text.IO qualified as Text (readFile)
+import Dhall qualified
+import Dhall.Core qualified as Dhall
+import Dhall.Import qualified
+import Dhall.Map qualified as DM
import Dhall.Marshal.Decode (DhallErrors (..), extractError)
-import qualified Dhall.Parser
-import qualified Dhall.Src
+import Dhall.Parser qualified
+import Dhall.Src qualified
import Podenv.Dhall hiding (name)
import Podenv.Prelude
import System.Directory
import System.Environment (setEnv, unsetEnv)
import System.FilePath.Posix (dropExtension, isExtensionOf, splitPath)
-import qualified Text.Show
+import Text.Show qualified
data Config
= -- | A standalone application, e.g. defaultSelector
@@ -69,7 +71,7 @@
load :: Maybe Text -> Maybe Text -> IO Config
load selectorM configTxt = case selectorM >>= defaultSelector of
Just c -> pure $ ConfigDefault (ApplicationRecord c)
- Nothing -> load' . Dhall.normalize <$> loadExpr configTxt
+ Nothing -> decodeExpr . Dhall.normalize <$> loadExpr configTxt
defaultSelector :: Text -> Maybe Application
defaultSelector s
@@ -161,8 +163,8 @@
podenvImportTxt = Text.replace "\n " "" $ Dhall.pretty podenvImport
-- | Pure config load
-load' :: DhallExpr -> Config
-load' expr = case loadConfig "" expr of
+decodeExpr :: DhallExpr -> Config
+decodeExpr expr = case loadConfig "" expr of
Success [(selector, Lit app)] -> ConfigApplication $ Lit (ensureName selector app)
Success [(_, x)] -> ConfigApplication x
Success [] -> error "No application found"
@@ -184,10 +186,10 @@
Dhall.RecordLit kv
| -- When the node has a "runtime" attribute, assume it is an app.
DM.member "runtime" kv ->
- (\app -> [(baseSelector, app)]) <$> loadApp expr
+ (\app -> [(baseSelector, app)]) <$> loadApp expr
| -- Otherwise, traverse each attributes
otherwise ->
- concat <$> traverse (uncurry loadCollection) (DM.toList kv)
+ concat <$> traverse (uncurry loadCollection) (DM.toList kv)
where
loadCollection n e
-- Skip leaf starting with `use`, otherwise they can be used and likely fail with:
@@ -323,7 +325,7 @@
Dhall.Lam _ fb1 (Dhall.Lam _ fb2 _) -> LamArg2 (getArgName fb1) (getArgName fb2) <$> Dhall.extract Dhall.auto expr
Dhall.Lam _ fb _
| Dhall.denote (Dhall.functionBindingAnnotation fb) == appType ->
- LamApp <$> Dhall.extract Dhall.auto expr
+ LamApp <$> Dhall.extract Dhall.auto expr
| otherwise -> LamArg (getArgName fb) <$> Dhall.extract Dhall.auto expr
_ -> Lit <$> Dhall.extract Dhall.auto expr
where
diff --git a/src/Podenv/Context.hs b/src/Podenv/Context.hs
--- a/src/Podenv/Context.hs
+++ b/src/Podenv/Context.hs
@@ -3,6 +3,7 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
@@ -17,8 +18,8 @@
-- | Runtime Context data types and lenses
module Podenv.Context where
-import qualified Data.Map.Strict as Map
-import qualified Data.Set as Set
+import Data.Map.Strict qualified as Map
+import Data.Set qualified as Set
import Lens.Family.TH (makeLenses)
import Podenv.Prelude
import System.Linux.Capabilities (Capability)
@@ -72,7 +73,7 @@
_environ :: Map Text Text,
-- | container volumes
_mounts :: Map FilePath Volume,
- _syscaps :: [Capability],
+ _syscaps :: Set.Set Capability,
_ro :: Bool,
-- | container devices
_devices :: Set FilePath,
diff --git a/src/Podenv/Dhall.hs b/src/Podenv/Dhall.hs
--- a/src/Podenv/Dhall.hs
+++ b/src/Podenv/Dhall.hs
@@ -2,6 +2,7 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
@@ -15,7 +16,7 @@
import Data.Char (toUpper)
import Data.Void
import Dhall.Core (Expr ())
-import qualified Dhall.TH
+import Dhall.TH qualified
import Lens.Family.TH (makeLensesBy)
-- | The hub submodule commit, this is only used for the PODENV environment value
diff --git a/src/Podenv/Env.hs b/src/Podenv/Env.hs
--- a/src/Podenv/Env.hs
+++ b/src/Podenv/Env.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -Wno-missing-signatures #-}
@@ -6,9 +7,9 @@
-- | The platform environment
module Podenv.Env where
-import qualified Data.List.NonEmpty
-import qualified Data.Maybe
-import qualified Data.Text
+import Data.List.NonEmpty qualified
+import Data.Maybe qualified
+import Data.Text qualified
import Lens.Family.TH (makeLenses)
import Podenv.Prelude
diff --git a/src/Podenv/Main.hs b/src/Podenv/Main.hs
--- a/src/Podenv/Main.hs
+++ b/src/Podenv/Main.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
@@ -25,30 +26,31 @@
)
where
-import qualified Data.Text
+import Data.Text qualified
import Data.Version (showVersion)
import Options.Applicative hiding (command)
import Paths_podenv (version)
-import qualified Podenv.Application
-import qualified Podenv.Build
-import qualified Podenv.Config
+import Podenv.Application qualified
+import Podenv.Build qualified
+import Podenv.Config qualified
import Podenv.Dhall
import Podenv.Prelude
import Podenv.Runtime (Context, Name (..), RuntimeEnv (..))
-import qualified Podenv.Runtime
-import qualified Podenv.Version (version)
+import Podenv.Runtime qualified
+import Podenv.Version qualified (version)
-- | podenv entrypoint
main :: IO ()
main = do
cli@CLI {..} <- usage =<< getArgs
+ when showManifest (printManifest configExpr >> exitSuccess)
when showDhallEnv (putTextLn Podenv.Config.podenvImportTxt >> exitSuccess)
when listCaps (printCaps >> exitSuccess)
when listApps (printApps configExpr >> exitSuccess)
(baseApp, mode, ctxName, re) <- cliConfigLoad cli
(be, app) <- Podenv.Build.prepare re baseApp
- ctx <- Podenv.Application.prepare app mode ctxName
+ ctx <- Podenv.Application.prepare mode app ctxName
if showApplication
then putTextLn $ showApp app ctx be re
@@ -60,13 +62,13 @@
-- | helper function to run a Application.
runApp :: Podenv.Runtime.RuntimeEnv -> Application -> IO ()
runApp re app = do
- ctx <- Podenv.Application.prepare app Podenv.Application.Regular (Name $ app ^. appName)
+ ctx <- Podenv.Application.prepare Podenv.Application.Regular app (Name $ app ^. appName)
Podenv.Runtime.execute re ctx
usage :: [String] -> IO CLI
usage args = do
cli <- handleParseResult $ execParserPure defaultPrefs cliInfo cliArgs
- pure $ cli {extraArgs = map toText appArgs}
+ pure $ cli {cliExtraArgs = map toText appArgs}
where
cliArgs = takeCliArgs [] args
appArgs = case drop (length cliArgs) args of
@@ -94,22 +96,24 @@
{ -- action modes:
listApps :: Bool,
listCaps :: Bool,
+ showManifest :: Bool,
showDhallEnv :: Bool,
showApplication :: Bool,
configExpr :: Maybe Text,
-- runtime env:
update :: Bool,
verbose :: Bool,
+ detach :: Bool,
-- app modifiers:
capsOverride :: [Capabilities -> Capabilities],
shell :: Bool,
namespace :: Maybe Text,
- -- TODO: add namespaced :: Bool (when set, namespace is the app name head)
name :: Maybe Text,
cliEnv :: [Text],
volumes :: [Text],
+ -- app selector and arguments:
selector :: Maybe Text,
- extraArgs :: [Text]
+ cliExtraArgs :: [Text]
}
-- WARNING: when adding strOption, update the 'strOptions' list
@@ -119,12 +123,14 @@
-- action modes:
<$> switch (long "list" <> help "List available applications")
<*> switch (long "list-caps" <> help "List available capabilities")
+ <*> switch (long "manifest" <> hidden)
<*> switch (long "dhall-env" <> hidden)
<*> switch (long "show" <> help "Show the environment without running it")
<*> optional (strOption (long "config" <> help "A config expression"))
-- runtime env:
<*> switch (long "update" <> help "Update the runtime")
<*> switch (long "verbose" <> help "Increase verbosity")
+ <*> switch (long "detach" <> hidden)
-- app modifiers:
<*> capsParser
<*> switch (long "shell" <> help "Start a shell instead of the application command")
@@ -183,21 +189,17 @@
Nothing -> getDataDir >>= \fp -> pure $ fp "volumes"
config <- Podenv.Config.load selector configExpr
- (args, baseApp) <- mayFail $ Podenv.Config.select config (maybeToList selector <> extraArgs)
- let app = cliPrepare cli args baseApp
+ (extraArgs, baseApp) <- mayFail $ Podenv.Config.select config (maybeToList selector <> cliExtraArgs)
+ let app = cliPrepare cli baseApp
name' = Name $ fromMaybe (app ^. appName) name
- re = RuntimeEnv {verbose, system, volumesDir}
+ re = RuntimeEnv {verbose, detach, system, extraArgs, volumesDir}
mode = if shell then Podenv.Application.Shell else Podenv.Application.Regular
pure (app, mode, name', re)
-- | Apply the CLI argument to the application
-cliPrepare :: CLI -> [Text] -> Application -> Application
-cliPrepare CLI {..} args = modifiers
+cliPrepare :: CLI -> Application -> Application
+cliPrepare CLI {..} = setShell . setEnvs . setVolumes . setCaps . setNS
where
- modifiers = setShell . setEnvs . setVolumes . setCaps . setNS . addArgs
-
- addArgs = appCommand %~ (<> args)
-
setNS = maybe id (appNamespace ?~) namespace
setShell = bool id setShellCap shell
@@ -214,7 +216,7 @@
where
infos =
["[+] runtime: " <> Podenv.Build.beInfos be, ""]
- <> ["[+] Capabilities", unwords appCaps, ""]
+ <> ["[+] Capabilities", unwords (sort appCaps), ""]
<> ["[+] Command", cmd]
cmd = Podenv.Runtime.showRuntimeCmd re ctx
appCaps = concatMap showCap Podenv.Application.capsAll
@@ -231,12 +233,8 @@
printApps :: Maybe Text -> IO ()
printApps configTxt = do
- config <- Podenv.Config.load Nothing configTxt
- let atoms = sortOn fst $ case config of
- Podenv.Config.ConfigDefault app -> [("default", Podenv.Config.Lit app)]
- Podenv.Config.ConfigApplication atom -> [("default", atom)]
- Podenv.Config.ConfigApplications xs -> xs
- showApp' (Podenv.Config.ApplicationRecord app) =
+ atoms <- configToAtoms <$> Podenv.Config.load Nothing configTxt
+ let showApp' (Podenv.Config.ApplicationRecord app) =
"Application" <> maybe "" (\desc -> " (" <> desc <> ")") (app ^. appDescription)
showFunc args app = "λ " <> args <> " → " <> showApp' app
showArg a = "<" <> show a <> ">"
@@ -247,3 +245,28 @@
Podenv.Config.LamApp _ -> "λ app → app"
showAtom (name, app) = name <> ": " <> showConfig app
traverse_ (putTextLn . showAtom) atoms
+
+configToAtoms :: Podenv.Config.Config -> [(Text, Podenv.Config.Atom)]
+configToAtoms = \case
+ Podenv.Config.ConfigDefault ar -> [("default", Podenv.Config.Lit ar)]
+ Podenv.Config.ConfigApplication atom -> [("default", atom)]
+ Podenv.Config.ConfigApplications xs -> sortOn fst xs
+
+printManifest :: Maybe Text -> IO ()
+printManifest configTxt = do
+ atoms <- configToAtoms <$> Podenv.Config.load Nothing configTxt
+ let re = Podenv.Runtime.defaultRuntimeEnv "/volume"
+ addNL = Data.Text.replace "--" "\\\n --"
+ doPrint name ar = do
+ putTextLn name
+ (be, app) <- Podenv.Build.prepare re ar
+ ctx <- Podenv.Application.prepare (Podenv.Application.Regular) app (Name name)
+ putTextLn . addNL $ showApp app ctx be re
+
+ printAppContext :: (Text, Podenv.Config.Atom) -> IO ()
+ printAppContext (name, atom) = case atom of
+ Podenv.Config.Lit app -> doPrint name (Podenv.Config.unRecord app)
+ Podenv.Config.LamArg _ f -> doPrint name (Podenv.Config.unRecord $ f "a")
+ Podenv.Config.LamArg2 _ _ f -> doPrint name (Podenv.Config.unRecord $ f "a" "b")
+ Podenv.Config.LamApp _ -> putTextLn $ name <> ": lamapp"
+ traverse_ (printAppContext) atoms
diff --git a/src/Podenv/Prelude.hs b/src/Podenv/Prelude.hs
--- a/src/Podenv/Prelude.hs
+++ b/src/Podenv/Prelude.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE CPP #-}
+{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-}
-- | Common functions
diff --git a/src/Podenv/Runtime.hs b/src/Podenv/Runtime.hs
--- a/src/Podenv/Runtime.hs
+++ b/src/Podenv/Runtime.hs
@@ -1,6 +1,7 @@
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
@@ -11,6 +12,8 @@
module Podenv.Runtime
( execute,
showRuntimeCmd,
+ getPodmanPodStatus,
+ deletePodmanPod,
-- * Podman helpers
podman,
@@ -27,14 +30,14 @@
)
where
-import qualified Data.Map.Strict as Map
-import qualified Data.Set
-import qualified Data.Text as Text
+import Data.Map.Strict qualified as Map
+import Data.Set qualified
+import Data.Text qualified as Text
import Podenv.Config (defaultSystemConfig)
import Podenv.Context
import Podenv.Dhall (SystemConfig (..), sysDns)
import Podenv.Prelude
-import qualified System.Process.Typed as P
+import System.Process.Typed qualified as P
execute :: RuntimeEnv -> Context -> IO ()
execute re ctx = do
@@ -53,7 +56,7 @@
exist <- doesPathExist fp
unless exist $ do
createDirectoryIfMissing True fp
- P.runProcess_ $ P.proc "chcon" ["system_u:object_r:container_file_t:s0", fp]
+ P.runProcess_ $ P.proc "/bin/chcon" ["system_u:object_r:container_file_t:s0", fp]
doExecute :: Context -> ContextEnvT ()
doExecute ctx = case ctx ^. runtimeCtx of
@@ -73,7 +76,7 @@
commonArgs :: Context -> [Text]
commonArgs Context {..} =
- concatMap (\c -> ["--cap-add", Text.drop 4 (show c)]) _syscaps
+ concatMap (\c -> ["--cap-add", show c]) $ sort $ Data.Set.toList _syscaps
bwrapRunArgs :: RuntimeEnv -> Context -> FilePath -> [String]
bwrapRunArgs RuntimeEnv {..} ctx@Context {..} fp = toString <$> args
@@ -86,9 +89,9 @@
networkArg
| _network = case _namespace of
- Just "host" -> []
- Just _ns -> error "Shared netns not implemented"
- Nothing -> [] -- TODO: implement private network namespace
+ Just "host" -> []
+ Just _ns -> error "Shared netns not implemented"
+ Nothing -> [] -- TODO: implement private network namespace
| otherwise = ["--unshare-net"]
volumeArg :: (FilePath, Volume) -> [Text]
@@ -145,13 +148,17 @@
data RuntimeEnv = RuntimeEnv
{ verbose :: Bool,
+ detach :: Bool,
system :: SystemConfig,
+ -- | The app argument provided on the command line
+ extraArgs :: [Text],
+ -- | The host location of the volumes directory, default to ~/.local/share/podenv/volumes
volumesDir :: FilePath
}
deriving (Show)
defaultRuntimeEnv :: FilePath -> RuntimeEnv
-defaultRuntimeEnv = RuntimeEnv True defaultSystemConfig
+defaultRuntimeEnv = RuntimeEnv True False defaultSystemConfig []
type ContextEnvT a = ReaderT RuntimeEnv IO a
@@ -182,10 +189,10 @@
hostnameArg = ["--hostname", unName _name]
networkArg
| _network =
- hostnameArg <> case _namespace of
- Just "host" -> ["--network", "host"]
- Just ns -> ["--network", "container:" <> infraName ns]
- Nothing -> maybe [] (\dns -> ["--dns=" <> dns]) (system ^. sysDns) <> portArgs
+ hostnameArg <> case _namespace of
+ Just "host" -> ["--network", "host"]
+ Just ns -> ["--network", "container:" <> infraName ns]
+ Nothing -> maybe [] (\dns -> ["--dns=" <> dns]) (system ^. sysDns) <> portArgs
| otherwise = ["--network", "none"]
volumeArg :: (FilePath, Volume) -> [Text]
@@ -213,6 +220,7 @@
args =
["run"]
<> podmanArgs ctx
+ <> ["--detach" | detach]
<> maybe [] (\h -> ["--hostname", h]) _hostname
<> cond _privileged ["--privileged"]
<> ["--rm"]
@@ -241,19 +249,23 @@
Unknown Text
deriving (Show, Eq)
-getPodmanStatus :: String -> ContextEnvT PodmanStatus
-getPodmanStatus cname = do
- (_, stdout', _) <- P.readProcess (podman ["inspect", cname, "--format", "{{.State.Status}}"])
+getPodmanPodStatus :: MonadIO m => Name -> m PodmanStatus
+getPodmanPodStatus (Name cname) = do
+ (_, stdout', _) <- P.readProcess (podman ["inspect", Text.unpack cname, "--format", "{{.State.Status}}"])
pure $ case stdout' of
"" -> NotFound
"running\n" -> Running
other -> Unknown (Text.dropWhileEnd (== '\n') $ decodeUtf8 other)
+deletePodmanPod :: MonadIO m => Name -> m ()
+deletePodmanPod (Name cname) =
+ P.runProcess_ (podman ["rm", toString cname])
+
ensureInfraNet :: Text -> ContextEnvT ()
ensureInfraNet ns = do
debug $ "Ensuring infra net for: " <> show ns
let pod = infraName ns
- infraStatus <- getPodmanStatus (toString pod)
+ infraStatus <- getPodmanPodStatus (Name pod)
case infraStatus of
Running -> pure ()
_ -> do
@@ -280,9 +292,9 @@
(Just ns, True) | ns /= mempty -> ensureInfraNet ns
_ -> pure ()
- status <- getPodmanStatus cname
- debug $ "Podman status of " <> toText cname <> ": " <> show status
- let cfail err = liftIO . mayFail . Left $ toText cname <> ": " <> err
+ status <- getPodmanPodStatus (ctx ^. name)
+ debug $ "Podman status of " <> cname <> ": " <> show status
+ let cfail err = liftIO . mayFail . Left $ cname <> ": " <> err
args <-
case status of
NotFound -> pure $ podmanRunArgs re ctx image
@@ -292,8 +304,8 @@
debug $ show cmd
P.runProcess_ cmd
where
- cname = toString (unName $ ctx ^. name)
+ cname = unName $ ctx ^. name
-- Delete a non-kept container and return the run args
recreateContainer re = do
- P.runProcess_ (podman ["rm", cname])
+ deletePodmanPod (ctx ^. name)
pure $ podmanRunArgs re ctx image
diff --git a/test/Spec.hs b/test/Spec.hs
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -1,20 +1,20 @@
+{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Main where
-import Data.Maybe (maybeToList)
import Data.Text (pack)
-import qualified Data.Text as Text
-import qualified Podenv.Application
-import qualified Podenv.Build
-import qualified Podenv.Config
-import qualified Podenv.Context
-import qualified Podenv.Dhall
+import Data.Text qualified as Text
+import Podenv.Application qualified
+import Podenv.Build qualified
+import Podenv.Config qualified
+import Podenv.Context qualified
+import Podenv.Dhall qualified
import Podenv.Env
-import qualified Podenv.Main
+import Podenv.Main qualified
import Podenv.Prelude (mayFail)
-import qualified Podenv.Runtime
+import Podenv.Runtime qualified
import System.Environment (getEnv, setEnv)
import Test.Hspec
@@ -29,6 +29,7 @@
setEnv "XDG_CACHE_HOME" (curHome <> "/.cache")
setEnv "HOME" "/home/user"
setEnv "WAYLAND_DISPLAY" "wayland-0"
+ setEnv "NIX_SSL_CERT_FILE" "/etc/hosts"
spec :: Podenv.Config.Config -> Spec
spec config = describe "unit tests" $ do
@@ -64,10 +65,10 @@
describe "cli parser" $ do
it "pass command args" $ do
cli <- Podenv.Main.usage ["--name", "test", "image:ubi8", "ls", "-la"]
- Podenv.Main.extraArgs cli `shouldBe` ["ls", "-la"]
+ Podenv.Main.cliExtraArgs cli `shouldBe` ["ls", "-la"]
it "handle separator" $ do
cli <- Podenv.Main.usage ["--name", "test", "image:ubi8", "--", "ls", "-la"]
- Podenv.Main.extraArgs cli `shouldBe` ["ls", "-la"]
+ Podenv.Main.cliExtraArgs cli `shouldBe` ["ls", "-la"]
describe "cli with single config" $ do
it "select app" $ cliTest "env" [] "env"
it "add args" $ cliTest "env" ["ls"] "env // { command = [\"ls\"]}"
@@ -82,9 +83,13 @@
it "nix:expr" $ cliTest "env" ["nix:test"] "def // { runtime.nix = \"test\", name = \"nix-a94a8f\" }"
describe "bwrap ctx" $ do
it "run simple" $ bwrapTest ["--shell"] (defBwrap <> ["/bin/sh"])
+ describe "nix test" $ do
+ it "nix run without args" $ nixTest "{ runtime.nix = \"test\"}" [] ["run", "test"]
+ it "nix run with args" $ nixTest "{env, test = { runtime.nix = \"test\"}}" ["test", "--help"] ["run", "test", "--", "--help"]
+ it "nix run with shell" $ nixTest "{env, test = { runtime.nix = \"test\", command = [\"test\"]}}" ["test", "--help"] ["shell", "test", "--command", "test", "--help"]
describe "podman ctx" $ do
it "run simple" $ podmanTest "env" ["run", "--rm", "--hostname", "env", "--name", "env", defImg]
- it "run syscaps" $ podmanTest "env // { syscaps = [\"NET_ADMIN\"] }" (defRun ["--hostname", "env", "--cap-add", "NET_ADMIN"])
+ it "run syscaps" $ podmanTest "env // { syscaps = [\"NET_ADMIN\"] }" (defRun ["--hostname", "env", "--cap-add", "CAP_NET_ADMIN"])
it "run hostdir" $ podmanTest "env // { volumes = [\"/tmp/test\"]}" (defRun ["--security-opt", "label=disable", "--hostname", "env", "--volume", "/tmp/test:/tmp/test"])
it "run volumes" $ podmanTest "env // { volumes = [\"nix-store:/nix\"]}" (defRun ["--hostname", "env", "--volume", "/data/nix-store:/nix"])
it "run home volumes" $
@@ -125,7 +130,7 @@
it "name override keep image" $ do
cli <- Podenv.Main.usage ["--name", "tmp", "--config", "{ name = \"firefox\", runtime.image = \"localhost/firefox\" }"]
(app, mode, ctxName, re) <- Podenv.Main.cliConfigLoad cli
- ctx <- Podenv.Application.preparePure testEnv app mode ctxName
+ ctx <- Podenv.Application.preparePure mode testEnv app ctxName
Podenv.Runtime.podmanRunArgs re ctx (getImg ctx) `shouldBe` ["run", "--rm", "--read-only=true", "--network", "none", "--name", "tmp", "localhost/firefox"]
where
defRun xs = ["run", "--rm"] <> xs <> ["--name", "env", defImg]
@@ -157,7 +162,7 @@
cli <- Podenv.Main.usage (args <> ["rootfs:/srv"])
(app, mode, ctxName, re') <- Podenv.Main.cliConfigLoad cli
let re = re' {Podenv.Runtime.system = Podenv.Config.defaultSystemConfig}
- ctx <- Podenv.Application.preparePure testEnv app mode ctxName
+ ctx <- Podenv.Application.preparePure mode testEnv app ctxName
Podenv.Runtime.bwrapRunArgs re ctx (getFP ctx) `shouldBe` expected
getImg ctx = case Podenv.Context._runtimeCtx ctx of
@@ -166,25 +171,32 @@
podmanCliTest args expected = do
cli <- Podenv.Main.usage (["--rw"] <> args)
- (app, mode, ctxName, re') <- Podenv.Main.cliConfigLoad cli
+ (cliApp, mode, ctxName, re') <- Podenv.Main.cliConfigLoad cli
+ (_, app) <- Podenv.Build.prepare re' cliApp
let re = re' {Podenv.Runtime.system = Podenv.Config.defaultSystemConfig}
- ctx <- Podenv.Application.preparePure testEnv app mode ctxName
+ ctx <- Podenv.Application.preparePure mode testEnv app ctxName
Podenv.Runtime.podmanRunArgs re ctx (getImg ctx) `shouldBe` expected
podmanTest code expected = do
app <- loadOne (addCap code "network = True, rw = True")
- ctx <- Podenv.Application.prepare app Podenv.Application.Regular (Podenv.Context.Name "env")
+ ctx <- Podenv.Application.prepare Podenv.Application.Regular app (Podenv.Context.Name "env")
Podenv.Runtime.podmanRunArgs defRe ctx (getImg ctx) `shouldBe` expected
- cliTest code args expectedCode = do
- cli@Podenv.Main.CLI {..} <- Podenv.Main.usage args
- config' <- loadConfig (Podenv.Main.selector cli) code
- (args', baseApp) <- mayFail $ Podenv.Config.select config' (maybeToList selector <> extraArgs)
- expected <- loadOne expectedCode
+ getApp code args = do
+ cli <- Podenv.Main.usage args
+ (baseApp, _, _, re) <- Podenv.Main.cliConfigLoad (cli {Podenv.Main.configExpr = Just . mkConfig $ code})
+ (_, app) <- Podenv.Build.prepare re baseApp
+ pure app
- let got = Podenv.Main.cliPrepare cli args' baseApp
+ cliTest gotCode args expectedCode = do
+ got <- getApp gotCode args
+ expected <- getApp expectedCode []
got `shouldBe` expected
+ nixTest code args expectedCommand = do
+ app <- getApp code args
+ drop 3 (Podenv.Dhall.command app) `shouldBe` expectedCommand
+
loadTest code expected = do
config' <- loadConfig Nothing code
let got = case config' of
@@ -196,20 +208,18 @@
addCap code capCode =
"( " <> code <> " // { capabilities = (" <> code <> ").capabilities // {" <> capCode <> "}})"
+ mkConfig code =
+ pack $
+ unlines
+ [ "let Podenv = env:PODENV",
+ "let Nix = Podenv.Nix",
+ "let def = { capabilities = {=}, runtime = Podenv.Image \"ubi8\" }",
+ "let env = def // { name = \"env\" }",
+ "let env2 = env // { name = \"beta\" } in",
+ code
+ ]
loadConfig s code =
- Podenv.Config.load
- s
- ( Just
- . pack
- $ unlines
- [ "let Podenv = env:PODENV",
- "let Nix = Podenv.Nix",
- "let def = { capabilities = {=}, runtime = Podenv.Image \"ubi8\" }",
- "let env = def // { name = \"env\" }",
- "let env2 = env // { name = \"beta\" } in",
- code
- ]
- )
+ Podenv.Config.load s (Just . mkConfig $ code)
loadOne code = do
config' <- loadConfig Nothing code