packages feed

podenv (empty) → 0.1.0

raw patch · 94 files changed

+3965/−0 lines, 94 filesdep +SHAdep +basedep +containers

Dependencies added: SHA, base, containers, dhall, directory, either, filepath, gitrev, hspec, lens-family-core, lens-family-th, linux-capabilities, optparse-applicative, podenv, relude, text, th-env, typed-process, unix

Files

+ .git/modules/hub/HEAD view
@@ -0,0 +1,1 @@+0cb06f35180a047ec98c30fb5fc14da7ea39cfc1
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Changelog++## 0.1.0 (2022-05-02)++- Initial release
+ LICENSE view
@@ -0,0 +1,201 @@+                                 Apache License+                           Version 2.0, January 2004+                        http://www.apache.org/licenses/++   TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++   1. Definitions.++      "License" shall mean the terms and conditions for use, reproduction,+      and distribution as defined by Sections 1 through 9 of this document.++      "Licensor" shall mean the copyright owner or entity authorized by+      the copyright owner that is granting the License.++      "Legal Entity" shall mean the union of the acting entity and all+      other entities that control, are controlled by, or are under common+      control with that entity. For the purposes of this definition,+      "control" means (i) the power, direct or indirect, to cause the+      direction or management of such entity, whether by contract or+      otherwise, or (ii) ownership of fifty percent (50%) or more of the+      outstanding shares, or (iii) beneficial ownership of such entity.++      "You" (or "Your") shall mean an individual or Legal Entity+      exercising permissions granted by this License.++      "Source" form shall mean the preferred form for making modifications,+      including but not limited to software source code, documentation+      source, and configuration files.++      "Object" form shall mean any form resulting from mechanical+      transformation or translation of a Source form, including but+      not limited to compiled object code, generated documentation,+      and conversions to other media types.++      "Work" shall mean the work of authorship, whether in Source or+      Object form, made available under the License, as indicated by a+      copyright notice that is included in or attached to the work+      (an example is provided in the Appendix below).++      "Derivative Works" shall mean any work, whether in Source or Object+      form, that is based on (or derived from) the Work and for which the+      editorial revisions, annotations, elaborations, or other modifications+      represent, as a whole, an original work of authorship. For the purposes+      of this License, Derivative Works shall not include works that remain+      separable from, or merely link (or bind by name) to the interfaces of,+      the Work and Derivative Works thereof.++      "Contribution" shall mean any work of authorship, including+      the original version of the Work and any modifications or additions+      to that Work or Derivative Works thereof, that is intentionally+      submitted to Licensor for inclusion in the Work by the copyright owner+      or by an individual or Legal Entity authorized to submit on behalf of+      the copyright owner. For the purposes of this definition, "submitted"+      means any form of electronic, verbal, or written communication sent+      to the Licensor or its representatives, including but not limited to+      communication on electronic mailing lists, source code control systems,+      and issue tracking systems that are managed by, or on behalf of, the+      Licensor for the purpose of discussing and improving the Work, but+      excluding communication that is conspicuously marked or otherwise+      designated in writing by the copyright owner as "Not a Contribution."++      "Contributor" shall mean Licensor and any individual or Legal Entity+      on behalf of whom a Contribution has been received by Licensor and+      subsequently incorporated within the Work.++   2. Grant of Copyright License. Subject to the terms and conditions of+      this License, each Contributor hereby grants to You a perpetual,+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable+      copyright license to reproduce, prepare Derivative Works of,+      publicly display, publicly perform, sublicense, and distribute the+      Work and such Derivative Works in Source or Object form.++   3. Grant of Patent License. Subject to the terms and conditions of+      this License, each Contributor hereby grants to You a perpetual,+      worldwide, non-exclusive, no-charge, royalty-free, irrevocable+      (except as stated in this section) patent license to make, have made,+      use, offer to sell, sell, import, and otherwise transfer the Work,+      where such license applies only to those patent claims licensable+      by such Contributor that are necessarily infringed by their+      Contribution(s) alone or by combination of their Contribution(s)+      with the Work to which such Contribution(s) was submitted. If You+      institute patent litigation against any entity (including a+      cross-claim or counterclaim in a lawsuit) alleging that the Work+      or a Contribution incorporated within the Work constitutes direct+      or contributory patent infringement, then any patent licenses+      granted to You under this License for that Work shall terminate+      as of the date such litigation is filed.++   4. Redistribution. You may reproduce and distribute copies of the+      Work or Derivative Works thereof in any medium, with or without+      modifications, and in Source or Object form, provided that You+      meet the following conditions:++      (a) You must give any other recipients of the Work or+          Derivative Works a copy of this License; and++      (b) You must cause any modified files to carry prominent notices+          stating that You changed the files; and++      (c) You must retain, in the Source form of any Derivative Works+          that You distribute, all copyright, patent, trademark, and+          attribution notices from the Source form of the Work,+          excluding those notices that do not pertain to any part of+          the Derivative Works; and++      (d) If the Work includes a "NOTICE" text file as part of its+          distribution, then any Derivative Works that You distribute must+          include a readable copy of the attribution notices contained+          within such NOTICE file, excluding those notices that do not+          pertain to any part of the Derivative Works, in at least one+          of the following places: within a NOTICE text file distributed+          as part of the Derivative Works; within the Source form or+          documentation, if provided along with the Derivative Works; or,+          within a display generated by the Derivative Works, if and+          wherever such third-party notices normally appear. The contents+          of the NOTICE file are for informational purposes only and+          do not modify the License. You may add Your own attribution+          notices within Derivative Works that You distribute, alongside+          or as an addendum to the NOTICE text from the Work, provided+          that such additional attribution notices cannot be construed+          as modifying the License.++      You may add Your own copyright statement to Your modifications and+      may provide additional or different license terms and conditions+      for use, reproduction, or distribution of Your modifications, or+      for any such Derivative Works as a whole, provided Your use,+      reproduction, and distribution of the Work otherwise complies with+      the conditions stated in this License.++   5. Submission of Contributions. Unless You explicitly state otherwise,+      any Contribution intentionally submitted for inclusion in the Work+      by You to the Licensor shall be under the terms and conditions of+      this License, without any additional terms or conditions.+      Notwithstanding the above, nothing herein shall supersede or modify+      the terms of any separate license agreement you may have executed+      with Licensor regarding such Contributions.++   6. Trademarks. This License does not grant permission to use the trade+      names, trademarks, service marks, or product names of the Licensor,+      except as required for reasonable and customary use in describing the+      origin of the Work and reproducing the content of the NOTICE file.++   7. Disclaimer of Warranty. Unless required by applicable law or+      agreed to in writing, Licensor provides the Work (and each+      Contributor provides its Contributions) on an "AS IS" BASIS,+      WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+      implied, including, without limitation, any warranties or conditions+      of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+      PARTICULAR PURPOSE. You are solely responsible for determining the+      appropriateness of using or redistributing the Work and assume any+      risks associated with Your exercise of permissions under this License.++   8. Limitation of Liability. In no event and under no legal theory,+      whether in tort (including negligence), contract, or otherwise,+      unless required by applicable law (such as deliberate and grossly+      negligent acts) or agreed to in writing, shall any Contributor be+      liable to You for damages, including any direct, indirect, special,+      incidental, or consequential damages of any character arising as a+      result of this License or out of the use or inability to use the+      Work (including but not limited to damages for loss of goodwill,+      work stoppage, computer failure or malfunction, or any and all+      other commercial damages or losses), even if such Contributor+      has been advised of the possibility of such damages.++   9. Accepting Warranty or Additional Liability. While redistributing+      the Work or Derivative Works thereof, You may choose to offer,+      and charge a fee for, acceptance of support, warranty, indemnity,+      or other liability obligations and/or rights consistent with this+      License. However, in accepting such obligations, You may act only+      on Your own behalf and on Your sole responsibility, not on behalf+      of any other Contributor, and only if You agree to indemnify,+      defend, and hold each Contributor harmless for any liability+      incurred by, or claims asserted against, such Contributor by reason+      of your accepting any such warranty or additional liability.++   END OF TERMS AND CONDITIONS++   APPENDIX: How to apply the Apache License to your work.++      To apply the Apache License to your work, attach the following+      boilerplate notice, with the fields enclosed by brackets "[]"+      replaced with your own identifying information. (Don't include+      the brackets!)  The text should be enclosed in the appropriate+      comment syntax for the file format. We also recommend that a+      file or class name and description of purpose be included on the+      same "printed page" as the copyright notice for easier+      identification within third-party archives.++   Copyright [yyyy] [name of copyright owner]++   Licensed under the Apache License, Version 2.0 (the "License");+   you may not use this file except in compliance with the License.+   You may obtain a copy of the License at++       http://www.apache.org/licenses/LICENSE-2.0++   Unless required by applicable law or agreed to in writing, software+   distributed under the License is distributed on an "AS IS" BASIS,+   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+   See the License for the specific language governing permissions and+   limitations under the License.
+ README.md view
@@ -0,0 +1,200 @@+# podenv: a container wrapper++> 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.+Using rootless containers, podenv let you run applications seamlessly.++## Overview and scope++The goal of podenv is to implement a modern application launcher:++- [Highlevel capability system](#capabilities)+- [Multiple runtimes](#runtimes)+- [VPN network namespace](#namespace)+- [Functional configuration](#configuration)+- [Simple to use](#usages)++Podenv differs from [toolbx](https://containertoolbx.org/) or [flatpak](https://flatpak.org/):++- Isolation by default: network or home directory access need to be explicitely enabled.+- Unopinionated runtime: applications are provided by distro packages or Containerfile.+- High level command line interface.++## Features++### <a name="capabilities"></a>Capabilities++Share resources with simple toggles:++- `--wayland` graphical display.+- `--pipewire` access audio and video streams.+- `--dbus` share the dbus session.+- See the full list in this configuration schema: [Capabilities.Type](https://github.com/podenv/hub/blob/main/schemas/Capabilities.dhall)++Mount directories with smart volumes:++- `--volume ~` share the home directory.+- `--volume web:~` use a volume named `web` for the container home.+- `--hostfile ./document.pdf` share a single file.++### <a name="runtimes"></a>Runtimes++Podenv works with multiple runtimes:++- Podman for container image and Containerfile.+- Bubblewrap for local rootfs and Nix Flakes. Checkout the [Howto use Nix tutorial](./docs/tutorials/nix.md).++The runtime integration is decoupled from the application description+so that more options can be added in the future.++### <a name="namespaces"></a>Namespace++Applications can share resources using the `--namespace NAME` option.+For example, a browser application can be attached to the network of a VPN application.+Checkout the [Configure a VPN howto](./docs/howtos/vpn.md).++### <a name="namespaces"></a>Configuration++Applications are user-defined with functionnal and re-usable expressions:++#### Firefox with a fedora container++```dhall+Application::{+, name = "firefox"+, description = Some "Mozilla Firefox"+, runtime = (./fedora.dhall).latest.useGraphic [ "firefox" ]+, command = [ "firefox", "--no-remote" ]+, capabilities = Capabilities::{ wayland = True, network = True }+}+```++The fedora useGraphic function defines a custom Containerfile:++```dhall+\(pkgs : List Text) ->+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}+    ''+, image_home = Some "/home/fedora"+, image_update = Some "dnf update -y"+}+```++> The graphic packages layer is shared by the other apps.++#### Nix Flakes++Podenv support the [Nix installables syntax](https://nixos.org/manual/nix/stable/command-ref/new-cli/nix.html#installables):++```dhall+Application::{+, name = "polyglot"+, description = Some "Tool to count lines of source code."+, runtime = Nix Flakes::{ installables = [ "github:podenv/polyglot.nix" ]}+, capabilities = Capabilities::{ cwd = True }+}+```++#### Hub++By default, podenv uses the [podenv/hub](https://github.com/podenv/hub) collection.+Run `podenv --list` to see the available applications.+++## <a name="usages"></a>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).+++# Documentation++Podenv documentation is organized into the following [four sections][documentation]:++[documentation]: https://www.divio.com/en/blog/documentation/++## Tutorials++These guides help you get your hands dirty with working examples:++* [Install and use podenv](./docs/tutorials/install.md)+* [Use an application](./docs/tutorials/use.md)+* [Create an application](./docs/tutorials/create.md)+* [Howto use Nix](./docs/tutorials/nix.md)++## Howtos++These cookbooks teach you how to solve specific tasks:++* [Configure a VPN](./docs/howtos/vpn.md)+* [Setup a custom image](./docs/howtos/image.md)+* [Contribute to podenv](./docs/howtos/contribute.md)++## Discussions++These posts explain the context and motivation behind this tool:++* [Declarative containers](./docs/discussions/declarative-containers.md)+* [Using dhall for configuration](./docs/discussions/dhall-configuration.md)+* [Roadmap](./docs/discussions/roadmap.md)++## References++These comprehensive resources cover details that other texts will gloss over:++* [Command line](./docs/references/command-line.md)+* [Configuration](./docs/references/configuration.md)
+ app/Main.hs view
@@ -0,0 +1,6 @@+module Main where++import qualified Podenv.Main++main :: IO ()+main = Podenv.Main.main
+ hub/Applications/_audinux.dhall view
@@ -0,0 +1,21 @@+let Podenv = ../Podenv.dhall++in  \(description : Text) ->+    \(packages : List Text) ->+    \(command : Text) ->+      Podenv.Application::{+      , description = Some description+      , runtime =+          Podenv.Container+            ( (./fedora.dhall).useGraphicImage+                "latest"+                ((./fedora.dhall).useCopr "ycollet/audinux")+                packages+            )+      , command = [ command ]+      , capabilities = Podenv.Capabilities::{+        , pipewire = True+        , x11 = True+        , alsa = True+        }+      }
+ hub/Applications/_ccrdaMAO.dhall view
@@ -0,0 +1,31 @@+let Podenv = ../Podenv.dhall++let url =+      let base =+            "https://ccrma.stanford.edu/planetccrma/mirror/fedora/linux/planetccrma"++      let release =+            "\$(rpm -E %fedora)/x86_64/planetccrma-repo-1.1-3.fc\$(rpm -E %fedora).ccrma.noarch.rpm"++      in  "${base}/${release}"++in  \(description : Text) ->+    \(packages : List Text) ->+    \(command : Text) ->+    \(alsa : Bool) ->+      Podenv.Application::{+      , description = Some description+      , runtime =+          Podenv.Container+            ( (./fedora.dhall).useGraphicImage+                "latest"+                "RUN rpm -Uvh ${url}"+                packages+            )+      , command = [ command ]+      , capabilities = Podenv.Capabilities::{+        , pipewire = True+        , x11 = True+        , alsa+        }+      }
+ hub/Applications/_graphicEditor.dhall view
@@ -0,0 +1,15 @@+\(name : Text) ->+\(desc : Text) ->+  let Podenv = ../Podenv.dhall++  in  Podenv.Application::{+      , name+      , description = Some desc+      , command = [ name ]+      , runtime = (./fedora.dhall).latest.useGraphic [ name ]+      , capabilities = Podenv.Capabilities::{+        , hostfile = True+        , wayland = True+        , x11 = True+        }+      }
+ hub/Applications/ardour.dhall view
@@ -0,0 +1,1 @@+./_ccrdaMAO.dhall "Digital Audio Workstation" [ "ardour6" ] "ardour6" True
+ hub/Applications/audacity.dhall view
@@ -0,0 +1,14 @@+let Podenv = ../Podenv.dhall++in  Podenv.Application::{+    , description = Some "Sound editor with graphical UI"+    , runtime =+        (./fedora.dhall).latest.useGraphic+          [ "audacity", "alsa-plugins-pulseaudio" ]+    , command = [ "audacity" ]+    , capabilities = Podenv.Capabilities::{+      , pipewire = True+      , pulseaudio = True+      , wayland = True+      }+    }
+ hub/Applications/blender.dhall view
@@ -0,0 +1,20 @@+let default =+    -- This is using nix because the fedora package doesn't come with ffmpeg+      (../Podenv.dhall).Application::{+      , description = Some "3D creation suite"+      , runtime = (./nix.dhall).uses [ ./nixGL.dhall ] [ "blender" ]+      , command = [ "nixGLIntel", "blender" ]+      , capabilities = (../Podenv.dhall).Capabilities::{+        , dri = True+        , x11 = True+        , pulseaudio = True+        }+      }++let fedora =+          default+      //  { runtime = (./fedora.dhall).latest.useGraphic [ "blender" ]+          , command = [ "blender" ]+          }++in  { default, fedora }
+ hub/Applications/brave.dhall view
@@ -0,0 +1,40 @@+let Podenv = ../Podenv.dhall++let container =+      let repo =+            ''+            [brave-browser]+            name=created by dnf config-manager from https://brave-browser-rpm-release.s3.brave.com/x86_64/+            baseurl=https://brave-browser-rpm-release.s3.brave.com/x86_64/+            enabled=1+            ''++      let key = "https://brave-browser-rpm-release.s3.brave.com/brave-core.asc"++      let extra =+            ''+            RUN rpm --import ${key}+            RUN echo -e ${Text/show repo} > /etc/yum.repos.d/brave-browser.repo+            ''++      in  \(packages : List Text) ->+            Podenv.Container+              ((./fedora.dhall).useGraphicCodecImage "latest" extra packages)++let default =+      Podenv.Application::{+      , description = Some "Brave Browser"+      , runtime = container [ "brave-browser" ]+      , command = [ "brave-browser" ]+      , capabilities = Podenv.Capabilities::{+        , dbus = True+        , network = True+        , x11 = True+        , dri = True+        , video = True+        , pipewire = True+        , pulseaudio = True+        }+      }++in  { default }
+ hub/Applications/centos.dhall view
@@ -0,0 +1,13 @@+let Podenv = ../Podenv.dhall++let image-ref = \(ver : Text) -> "registry.centos.org/centos:${ver}"++let default =+      Podenv.Application::{+      , name = "centos-7"+      , description = Some "CentOS 7 shell"+      , runtime = Podenv.Image (image-ref "7")+      , volumes = [ "cache-yum-c7:/var/cache/yum" ]+      }++in  { default }
+ hub/Applications/chromium.dhall view
@@ -0,0 +1,14 @@+let Podenv = ../Podenv.dhall++in  Podenv.Application::{+    , description = Some "open-source web browser"+    , runtime = (./fedora.dhall).latest.useGraphicCodec [ "chromium" ]+    , command = [ "chromium-browser" ]+    , capabilities = Podenv.Capabilities::{+      , network = True+      , wayland = True+      , pipewire = True+      , -- | chrome somehow still needs x11+        x11 = True+      }+    }
+ hub/Applications/debian.dhall view
@@ -0,0 +1,25 @@+-- | This application includes a builder+let Podenv = ../Podenv.dhall++let debian = ../Builders/debian.dhall++let mkUse =+      \(version : Text) ->+      \(packages : List Text) ->+        Podenv.Container (debian.image version packages)++let default =+      \(version : Text) ->+        Podenv.Application::{+        , description = Some "Debian ${version} shell"+        , runtime = Podenv.Image (debian.image-ref version)+        , volumes = debian.mkVolumes version+        , capabilities = Podenv.Capabilities::{+          , terminal = True+          , interactive = True+          , network = True+          , rw = True+          }+        }++in  { default = default "latest", bullseye.use = mkUse "bullseye" }
+ hub/Applications/electrum.dhall view
@@ -0,0 +1,8 @@+let Podenv = ../Podenv.dhall++in  Podenv.Application::{+    , description = Some "Electrum is an easy to use Bitcoin client"+    , runtime = (./fedora.dhall).latest.useGraphic [ "electrum" ]+    , command = [ "electrum" ]+    , capabilities = Podenv.Capabilities::{ network = True, wayland = True }+    }
+ hub/Applications/fbrnch.dhall view
@@ -0,0 +1,10 @@+let Podenv = ../Podenv.dhall++in  Podenv.Application::{+    , description = Some "Tool to update fedora packages branches"+    , runtime =+        (./fedora.dhall).latest.use+          [ "fbrnch", "krb5-workstation", "openssh-clients" ]+    , command = [ "fbrnch" ]+    , capabilities = Podenv.Capabilities::{ network = True, cwd = True }+    }
+ hub/Applications/fedora.dhall view
@@ -0,0 +1,152 @@+let Prelude = ../Prelude.dhall++let Podenv = ../Podenv.dhall++let fedora = ../Builders/fedora.dhall++let mkUse =+      \(version : Text) ->+      \(pre-task : Text) ->+      \(packages : List Text) ->+        Podenv.Container (fedora.image version pre-task packages)++let default =+      \(version : Text) ->+        Podenv.Application::{+        , runtime = Podenv.Image (fedora.image-ref (":" ++ version))+        , volumes = fedora.mkVolumes version+        , capabilities = Podenv.Capabilities::{+          , terminal = True+          , interactive = True+          , network = True+          , rw = True+          , root = True+          }+        }++let -- | Create a default app and use function+    useD =+      \(version : Text) -> { default = default version, use = mkUse version "" }++let fusion-repo =+      \(variant : Text) ->+      \(ver : Text) ->+        "https://download1.rpmfusion.org/${variant}/fedora/rpmfusion-${variant}-release-${ver}.noarch.rpm"++let -- | Extra layer to install common graphic packages+    extraGraphic =+      let extra-pkgs =+              [ "mesa-dri-drivers"+              , "mesa-vulkan-drivers"+              , "libglvnd-glx"+              , "glxinfo"+              , "gtk4"+              , "qt5-qtwayland"+              , "xdg-utils"+              , "glx-utils"+              , "harfbuzz-icu"+              ]+            # [ "dejavu-sans-mono-fonts", "dejavu-sans-mono-fonts" ]+            # [ "xdg-dbus-proxy", "xdg-desktop-portal-gtk" ]+            # [ "which"+              , "findutils"+              , "strace"+              , "procps-ng"+              , "file"+              , "xz"+              , "diffutils"+              ]+            # [ "pipewire-libs", "pulseaudio-libs", "pipewire-pulseaudio" ]++      in  ''+          RUN dnf install -y ${Prelude.Text.concatSep " " extra-pkgs}+          ''++let -- | Extra layer to install codec+    -- See: https://fedoraproject.org/wiki/Firefox_Hardware_acceleration+    extraGraphicCodec =+      let -- | A list of packages that are often required but missing from the requirements+          gfx-pkgs =+            [ "ffmpeg"+            , "libva"+            , "libva-utils"+            , "libva-intel-driver"+            , "libvdpau-va-gl"+            ]++      let repo = fusion-repo "free" "\$(rpm -E %fedora)"++      in  ''+          RUN dnf install -y ${repo} && dnf install -y ${Prelude.Text.concatSep+                                                           " "+                                                           gfx-pkgs}+          ''++let -- | Simpler helper where app == package == command+    simples =+      let -- | When the application name is the package and command name+          mkUseSimple =+            \(extra : Text) ->+            \(name : Text) ->+            \(desc : Text) ->+              Podenv.Application::{+              , name+              , description = Some desc+              , runtime = mkUse "latest" extra [ name ]+              , command = [ name ]+              }++      in  { useSimple = mkUseSimple ""+          , useGraphicSimple = mkUseSimple extraGraphic+          , useGraphicCodecSimple =+              mkUseSimple (extraGraphic ++ extraGraphicCodec)+          }++let -- | Base image access for extra customization+    images =+      let mkUseImage =+            \(extra : Text) ->+            \(version : Text) ->+            \(pre-task : Text) ->+              fedora.image version (extra ++ pre-task)++      in  { useImage = mkUseImage ""+          , useGraphicImage = mkUseImage extraGraphic+          , useGraphicCodecImage =+              mkUseImage (extraGraphic ++ extraGraphicCodec)+          }++let base =+      { default = default "latest"+      , latest =+        { use = mkUse "latest" ""+        , useGraphic = mkUse "latest" extraGraphic+        , useGraphicCodec = mkUse "latest" (extraGraphic ++ extraGraphicCodec)+        }+      , `34` = useD "34"+      , rawhide = useD "rawhide"+      , fusion =+          let ver = "34"++          let mkVariant =+                \(variant : Text) ->+                \(extra : Text) ->+                  { use =+                      mkUse+                        ver+                        (     extra+                          ++  "RUN dnf install -y "+                          ++  fusion-repo variant ver+                        )+                  }++          in      mkVariant "free" ""+              //  { nonfree =+                      mkVariant "nonfree" (extraGraphic ++ extraGraphicCodec)+                  }+      , useCopr =+          \(name : Text) ->+            "RUN dnf -y install dnf-plugins-core && dnf -y copr enable ${name}"+      }++in  base // simples // images
+ hub/Applications/feh.dhall view
@@ -0,0 +1,1 @@+./_graphicEditor.dhall "feh" "Display an image file"
+ hub/Applications/ffmpeg.dhall view
@@ -0,0 +1,9 @@+let Podenv = ../Podenv.dhall++in  Podenv.Application::{+    , description = Some+        "A complete, cross-platform solution to record, convert and stream audio and video"+    , runtime = (./fedora.dhall).latest.useGraphicCodec [ "ffmpeg" ]+    , command = [ "ffmpeg" ]+    , capabilities = Podenv.Capabilities::{ dri = True }+    }
+ hub/Applications/firefox.dhall view
@@ -0,0 +1,24 @@+let Podenv = ../Podenv.dhall++let minimal =+      Podenv.Application::{+      , description = Some "Mozilla Firefox"+      , runtime = (./fedora.dhall).latest.useGraphic [ "firefox" ]+      , command = [ "firefox", "--no-remote" ]+      , capabilities = Podenv.Capabilities::{ wayland = True, network = True }+      }++let default =+          minimal+      //  { runtime =+              (./fedora.dhall).latest.useGraphicCodec+                [ "firefox"+                , "gdouros-symbola-fonts"+                , "pipewire-pulseaudio"+                , "mozilla-ublock-origin"+                ]+          , capabilities =+              minimal.capabilities // { dri = True, pulseaudio = True }+          }++in  { default, minimal }
+ hub/Applications/flutter.dhall view
@@ -0,0 +1,23 @@+(../Podenv.dhall).Application::{+, description = Some "Flutter SDK"+, runtime =+    (./nix.dhall).uses+      [ ./nixGL.dhall ]+      [ "flutter"+      , "clang"+      , "pkg-config"+      , "gtk3"+      , "pcre"+      , "epoxy"+      , "glib.dev"+      , "mount"+      ]+, command = [ "nixGLIntel", "bash" ]+, capabilities = (../Podenv.dhall).Capabilities::{+  , terminal = True+  , interactive = True+  , dri = True+  , x11 = True+  , pulseaudio = True+  }+}
+ hub/Applications/gimp.dhall view
@@ -0,0 +1,1 @@+./_graphicEditor.dhall "gimp" "Raster graphics editor"
+ hub/Applications/google-chrome.dhall view
@@ -0,0 +1,17 @@+let Podenv = ../Podenv.dhall++let packages =+      [ "https://dl.google.com/linux/direct/google-chrome-stable_current_x86_64.rpm"+      ]++in  Podenv.Application::{+    , description = Some "Cross-platform web browser developed by Google"+    , runtime = (./fedora.dhall).latest.useGraphicCodec packages+    , command = [ "google-chrome" ]+    , capabilities = Podenv.Capabilities::{+      , network = True+      , wayland = True+      , -- | chrome somehow still needs x11+        x11 = True+      }+    }
+ hub/Applications/gworldclock.dhall view
@@ -0,0 +1,8 @@+let Podenv = ../Podenv.dhall++in  Podenv.Application::{+    , description = Some "Displays time and date in specified time zones."+    , runtime = (./debian.dhall).bullseye.use [ "gworldclock" ]+    , command = [ "gworldclock" ]+    , capabilities = Podenv.Capabilities::{ x11 = True }+    }
+ hub/Applications/hydrogen.dhall view
@@ -0,0 +1,1 @@+./_ccrdaMAO.dhall "Drum Machine" [ "hydrogen" ] "hydrogen" False
+ hub/Applications/inkscape.dhall view
@@ -0,0 +1,1 @@+./_graphicEditor.dhall "inkscape" "Open a svg file"
+ hub/Applications/kigo.dhall view
@@ -0,0 +1,8 @@+let Podenv = ../Podenv.dhall++in  Podenv.Application::{+    , description = Some "Go Board game"+    , runtime = (./fedora.dhall).latest.useGraphic [ "kigo", "dbus-x11" ]+    , command = [ "kigo" ]+    , capabilities = Podenv.Capabilities::{ pulseaudio = True, x11 = True }+    }
+ hub/Applications/librecad.dhall view
@@ -0,0 +1,1 @@+./_graphicEditor.dhall "librecad" "Free Open Source 2D CAD"
+ hub/Applications/libreoffice.dhall view
@@ -0,0 +1,1 @@+./_graphicEditor.dhall "libreoffice" "Open-Source office suite"
+ hub/Applications/linphone.dhall view
@@ -0,0 +1,7 @@+    (./fedora.dhall).useGraphicSimple "linphone" "Open Source VOIP project"+//  { capabilities = (../Podenv.dhall).Capabilities::{+      , network = True+      , pulseaudio = True+      , x11 = True+      }+    }
+ hub/Applications/lmms.dhall view
@@ -0,0 +1,1 @@+./_audinux.dhall "Let's make music" [ "lmms" ] "lmms"
+ hub/Applications/maim.dhall view
@@ -0,0 +1,7 @@+let default =+          (./fedora.dhall).useSimple "maim" "Screen capturing application (x11)"+      //  { capabilities = (../Podenv.dhall).Capabilities::{ x11 = True } }++let capture = default // { command = [ "maim", "-s", "-o", "-u" ] }++in  { default, capture }
+ hub/Applications/mplayer.dhall view
@@ -0,0 +1,12 @@+let Podenv = ../Podenv.dhall++in  Podenv.Application::{+    , description = Some "Media player software"+    , runtime = (./fedora.dhall).latest.useGraphicCodec [ "mplayer" ]+    , command = [ "mplayer" ]+    , capabilities = Podenv.Capabilities::{+      , dri = True+      , pulseaudio = True+      , wayland = True+      }+    }
+ hub/Applications/mumble.dhall view
@@ -0,0 +1,12 @@+let Podenv = ../Podenv.dhall++in  Podenv.Application::{+    , description = Some "VoIP solution"+    , runtime = (./fedora.dhall).latest.useGraphic [ "mumble", "opus" ]+    , command = [ "mumble" ]+    , capabilities = Podenv.Capabilities::{+      , network = True+      , pulseaudio = True+      , wayland = True+      }+    }
+ hub/Applications/mupdf.dhall view
@@ -0,0 +1,1 @@+./_graphicEditor.dhall "mupdf" "Display a pdf file"
+ hub/Applications/muse.dhall view
@@ -0,0 +1,1 @@+./_ccrdaMAO.dhall "Multitrack Virtual Studio" [ "muse" ] "muse4" False
+ hub/Applications/musescore.dhall view
@@ -0,0 +1,2 @@+    ./_ccrdaMAO.dhall "Notation Software" [ "musescore" ] "musescore" True+//  { capabilities = { pipewire = True, x11 = True, alsa = True, dri = True } }
+ hub/Applications/network.dhall view
@@ -0,0 +1,13 @@+-- | Network utility+let Podenv = ../Podenv.dhall++let http-server =+      \(port : Text) ->+        Podenv.Application::{+        , runtime = Podenv.Image ((../Builders/fedora.dhall).image-ref "latest")+        , command = [ "python3", "-u", "-m", "http.server", port ]+        , namespace = Some "host"+        , capabilities = Podenv.Capabilities::{ network = True, cwd = True }+        }++in  { http-server }
+ hub/Applications/nix.dhall view
@@ -0,0 +1,63 @@+let Podenv = ../Podenv.dhall++let setup = ../Builders/nix.dhall++let -- | A pinned reference for the nixpkgs+    nixpkgs =+      "github:NixOS/nixpkgs/7954a245e70238e08078baef7ff6459a67e229c3"++let -- | Setup a Nix runtime with custom installables and nixpkgs packages.+    uses =+      \(qualifiedInstallables : List Text) ->+      \(pkgs : List Text) ->+        Podenv.Nix+          Podenv.Flakes::{+          , nixpkgs = Some nixpkgs+          , installables =+                qualifiedInstallables+              # (../Prelude.dhall).List.map+                  Text+                  Text+                  (\(pkgs : Text) -> "${nixpkgs}#${pkgs}")+                  pkgs+          }++let usesExample =+        assert+      :     uses [ "flakes/url" ] [ "bash" ]+        ===  Podenv.Nix+               Podenv.Flakes::{+               , nixpkgs = Some nixpkgs+               , installables = [ "flakes/url", "${nixpkgs}#bash" ]+               }++let -- | Setup a Nix runtime with nixpkgs packages+    use =+      uses ([] : List Text)++let -- | Setup a Nix runtime+    useInstallables =+      \(installables : List Text) -> Podenv.Nix Podenv.Flakes::{ installables }++let useExample =+        assert+      :     use [ "bash" ]+        ===  Podenv.Nix+               Podenv.Flakes::{+               , nixpkgs = Some nixpkgs+               , installables = [ "${nixpkgs}#bash" ]+               }++let default =+      Podenv.Application::{+      , description = Some "Run the nix command"+      , capabilities = Podenv.Capabilities::{+        , terminal = True+        , interactive = True+        , network = True+        }+      , runtime = use [ "nix" ]+      , command = [ "nix" ]+      }++in  { setup, use, uses, useInstallables, default }
+ hub/Applications/nixGL.dhall view
@@ -0,0 +1,4 @@+-- | An Installable nixGL+let commit = "569f95d9577154b26d5ce774895fee727f070455"++in  "github:guibou/nixGL/${commit}#nixGLIntel"
+ hub/Applications/nixify.dhall view
@@ -0,0 +1,22 @@+let Podenv = ../Podenv.dhall++let setup = ../Builders/nix.dhall++let -- | Add nix to the application environment+    nixify =+      \(app : Podenv.Application.Type) ->+            app+        //  { environ =+                  app.environ+                # [ "NIX_SSL_CERT_FILE=/etc/pki/tls/certs/ca-bundle.crt"+                  , "PATH=/nix/var/nix/profiles/nix-install/bin:/bin:/sbin"+                  ]+            , volumes =+                  app.volumes+                # [ "nix-store:/nix"+                  , "nix-config:~/.config/nix"+                  , "nix-cache:~/.cache/nix"+                  ]+            }++in  nixify
+ hub/Applications/obs.dhall view
@@ -0,0 +1,14 @@+let Podenv = ../Podenv.dhall++in  Podenv.Application::{+    , description = Some "Open Broadcaster Software"+    , runtime = (./fedora.dhall).latest.useGraphicCodec [ "obs-studio" ]+    , command = [ "obs" ]+    , capabilities = Podenv.Capabilities::{+      , wayland = True+      , dri = True+      , dbus = True+      , video = True+      , pipewire = True+      }+    }
+ hub/Applications/openvpn.dhall view
@@ -0,0 +1,13 @@+(../Podenv.dhall).Application::{+, description = Some "VPN solution"+, runtime = (./fedora.dhall).latest.use [ "openvpn", "iproute" ]+, command = [ "openvpn" ]+, syscaps = [ "NET_ADMIN", "SYS_RESOURCE", "SETUID", "SETGID" ]+, capabilities = (../Podenv.dhall).Capabilities::{+  , root = True+  , network = True+  , tun = True+  , interactive = True+  , terminal = True+  }+}
+ hub/Applications/package.dhall view
@@ -0,0 +1,58 @@+{ audacity = ./audacity.dhall+, ardour = ./ardour.dhall+, blender = ./blender.dhall+, brave = ./brave.dhall+, centos = ./centos.dhall+, chromium = ./chromium.dhall+, debian = ./debian.dhall+, electrum = ./electrum.dhall+, fbrnch = ./fbrnch.dhall+, fedora = ./fedora.dhall+, feh = ./feh.dhall+, firefox = ./firefox.dhall+, flutter = ./flutter.dhall+, ffmpeg = ./ffmpeg.dhall+, gimp = ./gimp.dhall+, google-chrome = ./google-chrome.dhall+, gworldclock = ./gworldclock.dhall+, hydrogen = ./hydrogen.dhall+, inkscape = ./inkscape.dhall+, kigo = ./kigo.dhall+, librecad = ./librecad.dhall+, libreoffice = ./libreoffice.dhall+, linphone = ./linphone.dhall+, lmms = ./lmms.dhall+, maim = ./maim.dhall+, mplayer = ./mplayer.dhall+, mumble = ./mumble.dhall+, mupdf = ./mupdf.dhall+, muse = ./muse.dhall+, musescore = ./musescore.dhall+, network = ./network.dhall+, nix = ./nix.dhall+, nixify = ./nixify.dhall+, obs = ./obs.dhall+, openvpn = ./openvpn.dhall+, polyglot = ./polyglot.dhall+, pwsafe = ./pwsafe.dhall+, qjackctl = ./qjackctl.dhall+, qtractor = ./qtractor.dhall+, reaper = ./reaper.dhall+, rosegarden = ./rosegarden.dhall+, seq24 = ./seq24.dhall+, shell = ./shell.dhall+, ssh = ./ssh.dhall+, steam = ./steam.dhall+, streamtuner = ./streamtuner.dhall+, supercollider = ./supercollider.dhall+, tor = ./tor.dhall+, vcv = ./vcv.dhall+, virt-viewer = ./virt-viewer.dhall+, vlc = ./vlc.dhall+, vmpk = ./vmpk.dhall+, vnc-viewer = ./vnc-viewer.dhall+, vscode = ./vscode.dhall+, xeyes = ./xeyes.dhall+, youtube-dl = ./youtube-dl.dhall+, zeal = ./zeal.dhall+}
+ hub/Applications/polyglot.dhall view
@@ -0,0 +1,5 @@+(../Podenv.dhall).Application::{+, description = Some "Tool to count lines of source code."+, runtime = (./nix.dhall).useInstallables [ "github:podenv/polyglot.nix" ]+, capabilities = (../Podenv.dhall).Capabilities::{ cwd = True }+}
+ hub/Applications/pwsafe.dhall view
@@ -0,0 +1,23 @@+let Podenv = ../Podenv.dhall++let default =+      Podenv.Application::{+      , description = Some+          "A unix commandline program that manages encrypted password databases"+      , runtime = (./fedora.dhall).latest.use [ "pwsafe", "wl-clipboard" ]+      , capabilities = Podenv.Capabilities::{+        , terminal = True+        , interactive = True+        }+      }++let copy =+      \(name : Text) ->+            default+        //  { description = Some "Copy a password to the wayland clipboard"+            , capabilities = default.capabilities // { wayland = True }+            , command =+              [ "sh", "-c", "pwsafe -E -p ${name} | wl-copy -f -o -p" ]+            }++in  { default, copy }
+ hub/Applications/qjackctl.dhall view
@@ -0,0 +1,12 @@+let Podenv = ../Podenv.dhall++in  Podenv.Application::{+    , description = Some "Qt based JACK control application"+    , runtime =+        (./nix.dhall).useInstallables [ "github:podenv/modularix#qjackctl" ]+    , capabilities = Podenv.Capabilities::{+      , pipewire = True+      , x11 = True+      , alsa = True+      }+    }
+ hub/Applications/qtractor.dhall view
@@ -0,0 +1,5 @@+./_ccrdaMAO.dhall+  "Audio/MIDI multi-track sequencer"+  [ "qtractor" ]+  "qtractor"+  True
+ hub/Applications/reaper.dhall view
@@ -0,0 +1,9 @@+(../Podenv.dhall).Application::{+, description = Some "Complete digital audio production application"+, runtime = (./nix.dhall).useInstallables [ "github:podenv/modularix#reaper" ]+, capabilities = (../Podenv.dhall).Capabilities::{+  , dri = True+  , x11 = True+  , pipewire = True+  }+}
+ hub/Applications/rosegarden.dhall view
@@ -0,0 +1,5 @@+./_ccrdaMAO.dhall+  "Digital Audio Workstation"+  [ "rosegarden4" ]+  "rosegarden"+  True
+ hub/Applications/seq24.dhall view
@@ -0,0 +1,1 @@+./_audinux.dhall "MIDI loops sequencer" [ "seq24" ] "seq24"
+ hub/Applications/shell.dhall view
@@ -0,0 +1,9 @@+(../Podenv.dhall).Application::{+, description = Some "A simple terminal"+, capabilities = (../Podenv.dhall).Capabilities::{+  , terminal = True+  , interactive = True+  , network = True+  }+, runtime = (../Podenv.dhall).Image "ubi8"+}
+ hub/Applications/ssh.dhall view
@@ -0,0 +1,17 @@+let Podenv = ../Podenv.dhall++let client =+      \(host : Text) ->+        Podenv.Application::{+        , description = Some "OpenSSH client"+        , runtime = (./fedora.dhall).latest.use [ "openssh-clients" ]+        , command = [ "ssh", host ]+        , capabilities = Podenv.Capabilities::{+          , ssh = True+          , network = True+          , terminal = True+          , interactive = True+          }+        }++in  { client }
+ hub/Applications/steam.dhall view
@@ -0,0 +1,14 @@+let Podenv = ../Podenv.dhall++in  Podenv.Application::{+    , description = Some "Steam"+    , command = [ "steam" ]+    , runtime = (./fedora.dhall).fusion.nonfree.use [ "steam", "pciutils" ]+    , capabilities = Podenv.Capabilities::{+      , dri = True+      , x11 = True+      , pulseaudio = True+      , network = True+      , privileged = True+      }+    }
+ hub/Applications/streamtuner.dhall view
@@ -0,0 +1,12 @@+let Podenv = ../Podenv.dhall++in  Podenv.Application::{+    , description = Some "An internet radio browser"+    , runtime = (./fedora.dhall).latest.useGraphic [ "streamtuner" ]+    , command = [ "streamtuner2" ]+    , capabilities = Podenv.Capabilities::{+      , x11 = True+      , network = True+      , pulseaudio = True+      }+    }
+ hub/Applications/supercollider.dhall view
@@ -0,0 +1,15 @@+let Podenv = ../Podenv.dhall++in  Podenv.Application::{+    , description = Some+        "Programming environment for real-time audio and video processing"+    , runtime =+        (./fedora.dhall).latest.useGraphicCodec+          [ "supercollider", "pipewire-jack-audio-connection-kit" ]+    , command = [ "scide" ]+    , capabilities = Podenv.Capabilities::{+      , dri = True+      , x11 = True+      , pipewire = True+      }+    }
+ hub/Applications/tor.dhall view
@@ -0,0 +1,24 @@+let Podenv = ../Podenv.dhall++let browser =+      Podenv.Application::{+      , description = Some "Tor browser"+      , runtime =+          (./fedora.dhall).latest.use+            [ "torbrowser-launcher"+            , "dbus-glib"+            , "qt5-qtwayland"+            , "libXt"+            , "gtk3"+            ]+      , command =+        [ "sh", "-c", "torbrowser-launcher; echo Press enter to exit; read" ]+      , capabilities = Podenv.Capabilities::{+        , network = True+        , x11 = True+        , interactive = True+        }+      , volumes = [ "data-tb:~/" ]+      }++in  { browser }
+ hub/Applications/vcv.dhall view
@@ -0,0 +1,10 @@+(../Podenv.dhall).Application::{+, description = Some "The EuroRack simulator"+, runtime = (./nix.dhall).useInstallables [ "github:podenv/modularix#vcv" ]+, capabilities = (../Podenv.dhall).Capabilities::{+  , dri = True+  , x11 = True+  , pipewire = True+  , alsa = True+  }+}
+ hub/Applications/virt-viewer.dhall view
@@ -0,0 +1,9 @@+(../Podenv.dhall).Application::{+, description = Some "Display the graphical console for a virtual machine"+, runtime = (./fedora.dhall).latest.useGraphic [ "virt-viewer" ]+, command = [ "remote-viewer" ]+, capabilities = (../Podenv.dhall).Capabilities::{+  , wayland = True+  , network = True+  }+}
+ hub/Applications/vlc.dhall view
@@ -0,0 +1,9 @@+(../Podenv.dhall).Application::{+, description = Some "Media Player"+, runtime = (./nix.dhall).use [ "vlc" ]+, capabilities = (../Podenv.dhall).Capabilities::{+  , dri = True+  , x11 = True+  , pulseaudio = True+  }+}
+ hub/Applications/vmpk.dhall view
@@ -0,0 +1,8 @@+let Podenv = ../Podenv.dhall++in  Podenv.Application::{+    , description = Some "Virtual MIDI Piano Keyboard"+    , runtime = (./fedora.dhall).latest.useGraphic [ "vmpk" ]+    , command = [ "vmpk" ]+    , capabilities = Podenv.Capabilities::{ pipewire = True, wayland = True }+    }
+ hub/Applications/vnc-viewer.dhall view
@@ -0,0 +1,6 @@+(../Podenv.dhall).Application::{+, description = Some "Remote display client"+, runtime = (./fedora.dhall).latest.useGraphic [ "tigervnc" ]+, command = [ "vncviewer" ]+, capabilities = (../Podenv.dhall).Capabilities::{ x11 = True, network = True }+}
+ hub/Applications/vscode.dhall view
@@ -0,0 +1,35 @@+-- | This application includes a custom runtime to install the upstream repository key.+let Podenv = ../Podenv.dhall++let container =+      let repo =+            ''+            [code]+            name=Visual Studio Code+            baseurl=https://packages.microsoft.com/yumrepos/vscode+            enabled=1+            gpgcheck=1+            gpgkey=https://packages.microsoft.com/keys/microsoft.asc+            ''++      let key = "https://packages.microsoft.com/keys/microsoft.asc"++      let extra =+            ''+            RUN rpm --import ${key}+            RUN echo -e ${Text/show repo} > /etc/yum.repos.d/vscode.repo+            ''++      in  \(packages : List Text) ->+            Podenv.Container+              ((./fedora.dhall).useGraphicCodecImage "latest" extra packages)++let default =+      Podenv.Application::{+      , description = Some "Code editing"+      , runtime = container [ "code", "iproute" ]+      , command = [ "code", "--wait" ]+      , capabilities = Podenv.Capabilities::{ wayland = True, x11 = True }+      }++in  { default }
+ hub/Applications/xeyes.dhall view
@@ -0,0 +1,6 @@+(../Podenv.dhall).Application::{+, description = Some "Test graphical setup"+, runtime = (./fedora.dhall).`34`.use [ "xeyes" ]+, command = [ "xeyes" ]+, capabilities = (../Podenv.dhall).Capabilities::{ x11 = True }+}
+ hub/Applications/youtube-dl.dhall view
@@ -0,0 +1,9 @@+    (./fedora.dhall).useSimple+      "youtube-dl"+      "command-line program to download videos"+//  { capabilities = (../Podenv.dhall).Capabilities::{+      , network = True+      , cwd = True+      , terminal = True+      }+    }
+ hub/Applications/zeal.dhall view
@@ -0,0 +1,6 @@+    (./fedora.dhall).useGraphicSimple+      "zeal"+      "Offline documentation browser inspired by Dash"+//  { volumes = [ "cache-zeal:~" ]+    , capabilities = (../Podenv.dhall).Capabilities::{ x11 = True }+    }
+ hub/Builders/debian.dhall view
@@ -0,0 +1,26 @@+let Prelude = ../Prelude.dhall++let Podenv = ../Podenv.dhall++let image-ref = \(ver : Text) -> "docker.io/library/debian:${ver}"++let mkVolumes = \(ver : Text) -> [ "cache-apt-${ver}:/var/cache/apt" ]++let image =+      \(ver : Text) ->+      \(pkgs : List Text) ->+        Podenv.ContainerBuild::{+        , containerfile =+            ''+            FROM ${image-ref ver}+            ARG USER_UID+            RUN ${./mkUser.dhall "debian"}+            RUN apt-get update+            RUN apt-get install -y ${Prelude.Text.concatSep " " pkgs}+            ''+        , image_volumes = mkVolumes ver+        , image_home = Some "/home/debian"+        , image_update = Some "apt-get update"+        }++in  { image-ref, mkVolumes, image }
+ hub/Builders/fedora.dhall view
@@ -0,0 +1,31 @@+let Prelude = ../Prelude.dhall++let Podenv = ../Podenv.dhall++let image-ref = \(ver : Text) -> "registry.fedoraproject.org/fedora${ver}"++let mkVolumes = \(ver : Text) -> [ "cache-dnf-${ver}:/var/cache/dnf" ]++let base-image =+      \(from : Text) ->+      \(ver : Text) ->+      \(pre-task : Text) ->+      \(pkgs : List Text) ->+        Podenv.ContainerBuild::{+        , containerfile =+            ''+            FROM ${from}+            ARG USER_UID+            RUN ${./mkUser.dhall "fedora"}+            ${pre-task}+            RUN dnf update -y+            RUN dnf install -y ${Prelude.Text.concatSep " " pkgs}+            ''+        , image_volumes = mkVolumes ver+        , image_home = Some "/home/fedora"+        , image_update = Some "dnf update -y"+        }++let image = \(ver : Text) -> base-image (image-ref (":" ++ ver)) ver++in  { image-ref, mkVolumes, base-image, image }
+ hub/Builders/mkUser.dhall view
@@ -0,0 +1,6 @@+let uid = "\${USER_UID}"++in  \(name : Text) ->+          "useradd -u ${uid} -d /home/${name} -m ${name} && "+      ++  "mkdir -p /home/${name}/.cache /home/${name}/.config /run/user/${uid} /run/user/0 && "+      ++  "chown -R ${uid}:${uid} /home/${name} /run/user/"
+ hub/Builders/nix.dhall view
@@ -0,0 +1,48 @@+-- | The default nix builder+let Prelude = ../Prelude.dhall++let Podenv = ../Podenv.dhall++let home = "/home/user"++in  Podenv.Application::{+    , description = Some "Setup the nix store"+    , capabilities = Podenv.Capabilities::{ network = True }+    , command =+        let version = "2.8.0"++        let hash =+              "0b32afd8c9147532bf8ce8908395b1b4d6dde9bedb0fcf5ace8b9fe0bd4c075c"++        let default-config =+              ''+              sandbox = false+              build-users-group =+              experimental-features = nix-command flakes+              ''++        let args =+              [ "test -d /nix/var || ("+              , Prelude.Text.concatSep+                  " && "+                  [ "cd /tmp"+                  , "curl -OL https://nixos.org/releases/nix/nix-${version}/nix-${version}-x86_64-linux.tar.xz"+                  , "echo '${hash}  nix-${version}-x86_64-linux.tar.xz' | sha256sum -c"+                  , "tar xf nix-${version}-x86_64-linux.tar.xz"+                  , "/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"+                  ]+              , "); test -f ~/.config/nix/nix.conf || ("+              , "echo -en ${Text/show default-config} > ~/.config/nix/nix.conf"+              , "); /nix/var/nix/profiles/nix-install/bin/nix --version"+              ]++        in  [ "bash", "-c", Prelude.Text.concatSep " " args ]+    , volumes =+      [ "nix-store:/nix", "nix-config:~/.config/nix", "nix-setup-home:~/" ]+    , runtime = Podenv.Rootfs "/"+    }
+ hub/Podenv.dhall view
@@ -0,0 +1,1 @@+./schemas/package.dhall
+ hub/Prelude.dhall view
@@ -0,0 +1,35 @@+{- This file provides a central `Prelude` import for the rest of the library to+   use so that the integrity check only needs to be updated in one place+   whenever upgrading the interpreter.++   This allows the user to provide their own Prelude import using the+   `DHALL_PRELUDE` environment variable, like this:++   ```+   $ export DHALL_PRELUDE='https://prelude.dhall-lang.org/package.dhall sha256:...'+   ```++   Note that overriding the Prelude in this way only works if this repository+   is imported locally.  Remote imports do not have access to environment+   variables and any attempt to import one will fall back to the next available+   import.  To learn more, read:++   * https://github.com/dhall-lang/dhall-lang/wiki/Safety-guarantees#cross-site-scripting-xss++   This file also provides an import without the integrity check as a slower+   fallback if the user is using a different version of the Dhall interpreter.++   This pattern is documented in the dhall-nethack repo:++   * https://github.com/dhall-lang/dhall-nethack/blob/master/Prelude.dhall+-}+  env:DHALL_PRELUDE+? { Text.concatSep+    =+      https://prelude.dhall-lang.org/v17.0.0/Text/concatSep+        sha256:e4401d69918c61b92a4c0288f7d60a6560ca99726138ed8ebc58dca2cd205e58+  , List.map+    =+      https://prelude.dhall-lang.org/v17.0.0/List/map+        sha256:dd845ffb4568d40327f2a817eb42d1c6138b929ca758d50bc33112ef3c885680+  }
+ hub/package.dhall view
@@ -0,0 +1,2 @@+-- | Welcome to the hub package.+./schemas/package.dhall // { Hub = ./Applications/package.dhall }
+ hub/schemas/Application.dhall view
@@ -0,0 +1,31 @@+{ Type =+    { -- | The application name, default to the parent key.+      name : Text+    , description : Optional Text+    , -- | The application runtime.+      runtime : ./Runtime.dhall+    , -- | An optional namespace name.+      namespace : Optional Text+    , -- | The application capabilities.+      capabilities : (./Capabilities.dhall).Type+    , -- | List of system capabilities(7).+      syscaps : List Text+    , -- | Process environment.+      environ : List Text+    , -- | Extra volumes.+      volumes : List Text+    , -- | Optional command and its argument.+      command : List Text+    }+, default =+  { -- The name defaults to the cli selector+    name = ""+  , description = None Text+  , namespace = None Text+  , capabilities = (./Capabilities.dhall).default+  , syscaps = [] : List Text+  , environ = [] : List Text+  , volumes = [] : List Text+  , command = [] : List Text+  }+}
+ hub/schemas/Capabilities.dhall view
@@ -0,0 +1,67 @@+{ Type =+    { -- Process i/o+      --+      -- | Attach a terminal, imply interactive+      terminal : Bool+    , -- | Attach stdin+      interactive : Bool+    , --+      -- Process perms+      --+      -- | Run as root+      root : Bool+    , -- | Mount the rootfs as read write+      rw : Bool+    , -- | Run with extra privileges+      privileged : Bool+    , --+      -- Host service+      --+      wayland : Bool+    , pipewire : Bool+    , dbus : Bool+    , pulseaudio : Bool+    , x11 : Bool+    , ssh : Bool+    , gpg : Bool+    , --+      -- Host devices+      --+      video : Bool+    , dri : Bool+    , kvm : Bool+    , alsa : Bool+    , network : Bool+    , tun : Bool+    , --+      -- Host filesystem+      --+      -- | Mount the current working directory+      cwd : Bool+    , -- | Mount host paths given on the cli+      hostfile : Bool+    }+, -- todo: codegen the defaults+  default =+  { terminal = False+  , interactive = False+  , root = False+  , privileged = False+  , rw = False+  , wayland = False+  , pipewire = False+  , dbus = False+  , pulseaudio = False+  , x11 = False+  , ssh = False+  , gpg = False+  , video = False+  , dri = False+  , kvm = False+  , alsa = False+  , network = False+  , tun = False+  , cwd = False+  , hostfile = False+  }+}
+ hub/schemas/ContainerBuild.dhall view
@@ -0,0 +1,18 @@+-- | How to build a local container image+{ Type =+    { containerfile : Text+    , -- TODO: this atttribute should be named `volumes`, but this is not possible until https://github.com/dhall-lang/dhall-haskell/pull/2285+      image_volumes : List Text+    , -- TODO: this attribute should be named `image`+      image_name : Optional Text+    , -- TODO: this attribute should be named `home`+      image_home : Optional Text+    , image_update : Optional Text+    }+, default =+  { image_volumes = [] : List Text+  , image_name = None Text+  , image_home = None Text+  , image_update = None Text+  }+}
+ hub/schemas/Flakes.dhall view
@@ -0,0 +1,12 @@+-- | A podenv nix runtime description:+--+-- - `nixpkgs` is an optional pin for the main package set+--   when set, this is added to the nix command: ["--override-input" "nixpkgs" "${nixpkgs}"]+--   so that installables inputs share the same set.+--   This is necessary for nixGL, see: https://github.com/guibou/nixGL/pull/97+-- - `installables` is a list of nix flakes,+--   see: https://nixos.org/manual/nix/stable/command-ref/new-cli/nix.html#installables+--+{ Type = { nixpkgs : Optional Text, installables : List Text }+, default.nixpkgs = None Text+}
+ hub/schemas/Runtime.dhall view
@@ -0,0 +1,10 @@+-- | The application runtime:+-- Image: an existing image ref+-- Nix: a nix expression+-- Container: a static container build+-- Rootfs: a local directory+< Image : Text+| Nix : (./Flakes.dhall).Type+| Container : (./ContainerBuild.dhall).Type+| Rootfs : Text+>
+ hub/schemas/System.dhall view
@@ -0,0 +1,4 @@+-- | The global system configuration.+{ Type = { dns : Optional Text, data_volumes_dir : Optional Text }+, default = { dns = None Text, data_volumes_dir = None Text }+}
+ hub/schemas/package.dhall view
@@ -0,0 +1,19 @@+{ Application = ./Application.dhall+, Capabilities = ./Capabilities.dhall+, ContainerBuild = ./ContainerBuild.dhall+, System = ./System.dhall+, Image = (./Runtime.dhall).Image+, Nix = (./Runtime.dhall).Nix+, Flakes = ./Flakes.dhall+, Container = (./Runtime.dhall).Container+, Rootfs = (./Runtime.dhall).Rootfs+, Containerfile =+    let -- "A helper function to simplify documentation..."+        func+        : Text -> ./Runtime.dhall+        = \(containerfile : Text) ->+            (./Runtime.dhall).Container+              (./ContainerBuild.dhall)::{ containerfile }++    in  func+}
+ podenv.cabal view
@@ -0,0 +1,99 @@+cabal-version:      3.0+name:               podenv+version:            0.1.0+synopsis:           A container wrapper+description:+    Podenv provides a declarative interface to manage containerized applications.+    .+    Using rootless containers, podenv let you run applications seamlessly.+    .+homepage:           https://github.com/podenv/podenv#readme+bug-reports:        https://github.com/podenv/podenv/issues+license:            Apache-2.0+license-file:       LICENSE+extra-doc-files:    CHANGELOG.md+                    README.md+author:             Tristan Cacqueray+maintainer:         tdecacqu@redhat.com+copyright:          2021 Red Hat+category:           Development+extra-source-files: test/*.dhall+                    hub/*.dhall+                    hub/**/*.dhall+                    .git/modules/hub/HEAD++source-repository head+  type:             git+  location:         https://github.com/podenv/podenv.git++flag ci+  description: Make warnings error+  default:     False+  manual:      True++common common+  if flag(ci)+    ghc-options:    -Werror+  ghc-options:      -Wall+                    -Wcompat+                    -Widentities+                    -Wincomplete-uni-patterns+                    -Wincomplete-record-updates+                    -Wno-missing-pattern-synonym-signatures+  if impl(ghc >= 8.0)+    ghc-options:    -Wredundant-constraints+  if impl(ghc >= 8.2)+    ghc-options:    -fhide-source-paths+  if impl(ghc >= 8.4)+    ghc-options:    -Wpartial-fields+  if impl(ghc >= 8.10)+    ghc-options:    -Wunused-packages+  default-language: Haskell2010++library+  import:           common+  build-depends:    base < 5+                  , SHA+                  , containers+                  , dhall >= 1.39+                  , directory+                  , unix+                  , either+                  , filepath+                  , gitrev+                  , lens-family-core+                  , lens-family-th+                  , linux-capabilities+                  , optparse-applicative+                  , relude >= 0.7+                  , text+                  , th-env+                  , typed-process+                  , unix+  hs-source-dirs:   src+  exposed-modules:  Podenv.Application+                  , Podenv.Build+                  , Podenv.Config+                  , Podenv.Context+                  , Podenv.Dhall+                  , Podenv.Env+                  , Podenv.Main+                  , Podenv.Prelude+                  , Podenv.Runtime+                  , Podenv.Version+  other-modules:    Paths_podenv+  autogen-modules:  Paths_podenv++executable podenv+  import:           common+  hs-source-dirs:   app+  main-is:          Main.hs+  build-depends:    base, podenv+  ghc-options:      -threaded -rtsopts -with-rtsopts=-N++test-suite tests+  import:           common+  type:             exitcode-stdio-1.0+  hs-source-dirs:   test+  main-is:          Spec.hs+  build-depends:    base, hspec, podenv, text
+ src/Podenv/Application.hs view
@@ -0,0 +1,445 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE NoImplicitPrelude #-}+{-# OPTIONS_GHC -fno-warn-missing-export-lists #-}++-- | This module contains the capability logic.+-- The goal is to convert an Application into a Context+--+-- This module performs read-only IO+module Podenv.Application+  ( prepare,+    preparePure,+    capsAll,+    Cap (..),+    Mode (..),+  )+where++import qualified Data.Map+import qualified Data.Text as Text+import qualified Data.Text.IO as Text+import qualified Podenv.Build+import Podenv.Dhall+import Podenv.Env+import Podenv.Prelude+import qualified Podenv.Runtime as Ctx+import qualified System.Posix.Files++data Mode = Regular | Shell++-- | Converts an Application into a Context+prepare :: Application -> Mode -> Ctx.Name -> IO Ctx.Context+prepare app mode ctxName = do+  appEnv <- Podenv.Env.new+  preparePure appEnv app mode 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+  home <- getContainerHome+  runReaderT (doPrepare app mode ctxName home) (appEnv home)+  where+    appEnv home = envBase & appHomeDir .~ (toString <$> home)++    getContainerHome+      | app ^. appCapabilities . capRoot = pure $ Just "/root"+      | otherwise = case app ^. appRuntime of+        Container cb -> pure $ cb ^. cbImage_home+        Rootfs fp -> fmap toText <$> (envBase ^. rootfsHome) (toString fp)+        Nix _ -> pure $ toText <$> envBase ^. hostHomeDir+        Image _ -> pure Nothing++doPrepare :: Application -> Mode -> Ctx.Name -> Maybe Text -> AppEnvT Ctx.Context+doPrepare app mode ctxName appHome = do+  uid <- asks _hostUid+  let baseCtx =+        (Ctx.defaultContext ctxName runtimeCtx)+          { Ctx._uid = uid,+            Ctx._namespace = app ^. appNamespace+          }++  ctx <-+    foldM addVolume baseCtx (app ^. appVolumes)+      >>= flip (foldM setCaps) capsAll++  setCommand <- case mode of+    Regular ->+      if app ^. appCapabilities . capHostfile+        then resolveFileArgs $ app ^. appCommand+        else pure $ Ctx.command .~ app ^. appCommand+    Shell -> pure $ Ctx.command .~ ["/bin/sh"]++  pure (validate . setCommand . modifiers $ ctx)+  where+    runtimeCtx = case app ^. appRuntime of+      Image x -> Ctx.Container $ Ctx.ImageName x+      Rootfs root -> Ctx.Bubblewrap $ toString root+      Container cb -> Podenv.Build.containerBuildRuntime cb+      Nix _ -> Podenv.Build.nixRuntime++    validate ctx = case runtimeCtx of+      Ctx.Bubblewrap _ | null (ctx ^. Ctx.command) -> ctx & Ctx.command .~ ["/bin/sh"]+      _ -> ctx++    modifiers :: Ctx.Context -> Ctx.Context+    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")))+      Nothing -> id++    -- Check if path is part of a mount point+    isMounted :: FilePath -> Ctx.Context -> Bool+    isMounted fp ctx = any isPrefix mountPaths+      where+        mountPaths = Data.Map.keys $ ctx ^. Ctx.mounts+        isPrefix x = fp `isPrefixOf` x++    ensureWorkdir ctx = case appHome of+      (Just x) | isMounted (toString x) ctx -> ctx & Ctx.workdir `setWhenNothing` toString x+      _ -> ctx++    setEnv = case appHome of+      Just x -> Ctx.addEnv "HOME" x+      _ -> id++    -- Some capabilities do not work with selinux+    noSelinuxCaps = [capWayland, capX11]+    hasPrivCap = any (\l -> app ^. appCapabilities . l) noSelinuxCaps+    -- When using host device, selinux also needs to be disabled+    hasDevice ctx = ctx ^. Ctx.devices /= mempty+    -- When using direct host path, its simpler to disable selinux too. That can be improved though+    isHostPath = \case+      Ctx.MkVolume _ (Ctx.HostPath _) -> True+      _anyOtherVolume -> False+    hasHostPath ctx = any isHostPath (toList $ ctx ^. Ctx.mounts)+    disableSelinux ctx+      | hasPrivCap || hasDevice ctx || hasHostPath ctx = ctx & Ctx.selinux .~ False+      | otherwise = ctx++    setRunAs = case appHome of+      -- To keep it simple, when the app home is in `/home`, assume we share the host uid.+      Just h | "/home" `Text.isPrefixOf` h -> Ctx.runAs `setWhenNothing` Ctx.RunAsHostUID+      _ -> id++    addSysCaps ctx = foldr addSysCap ctx (app ^. appSyscaps)+    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 :)++    addEnvs ctx = foldr addEnv ctx (app ^. appEnviron)+    addEnv :: Text -> Ctx.Context -> Ctx.Context+    addEnv env =+      let (k, v) = Text.breakOn "=" env+       in Ctx.addEnv k (Text.drop 1 v)++    setCaps = capContextApply $ app ^. appCapabilities+    capContextApply :: Capabilities -> Ctx.Context -> Cap -> AppEnvT Ctx.Context+    capContextApply appCaps ctx Cap {..} =+      if appCaps ^. capLens+        then capSet ctx+        else pure ctx++-- | CapInfo describes a capability and how it modify the runtime context+data Cap = Cap+  { capName :: Text,+    capDescription :: Text,+    -- | How to get the capability value from the user provided record:+    capLens :: Lens' Capabilities Bool,+    -- | How the capability change the context:+    capSet :: Ctx.Context -> AppEnvT Ctx.Context+  }++-- | The main list of capabilities+capsAll, capsToggle :: [Cap]+capsAll = capsToggle+capsToggle =+  [ Cap "root" "run as root" capRoot (contextSet Ctx.runAs (Just Ctx.RunAsRoot)),+    Cap "terminal" "allocate a tty" capTerminal setTerminal,+    Cap "interactive" "interactive mode" capInteractive (contextSet Ctx.interactive True),+    Cap "dbus" "share session dbus socket" capDbus setDbus,+    Cap "wayland" "share wayland socket" capWayland setWayland,+    Cap "pipewire" "share pipewire socket" capPipewire setPipewire,+    Cap "video" "share video devices" capVideo setVideo,+    Cap "dri" "share graphic device" capDri setDri,+    Cap "kvm" "share kvm device" capKvm (pure . Ctx.addDevice "/dev/kvm"),+    Cap "tun" "share tun device" capTun (pure . Ctx.addDevice "/dev/net/tun"),+    Cap "alsa" "share alsa devices" capAlsa (pure . Ctx.addDevice "/dev/snd"),+    Cap "pulseaudio" "share pulseaudio socket" capPulseaudio setPulseaudio,+    Cap "ssh" "share ssh agent and keys" capSsh setSsh,+    Cap "gpg" "share gpg agent and keys" capGpg setGpg,+    Cap "x11" "share x11 socket" capX11 setX11,+    Cap "cwd" "mount cwd" capCwd setCwd,+    Cap "network" "enable network" capNetwork setNetwork,+    Cap "hostfile" "mount command file arg" capHostfile pure,+    Cap "rw" "mount rootfs rw" capRw (contextSet Ctx.ro False),+    Cap "privileged" "run with extra privileges" capPrivileged (contextSet Ctx.privileged True)+  ]++setNetwork :: Ctx.Context -> AppEnvT Ctx.Context+setNetwork ctx = do+  setResolvConf <- liftIO $ ensureResolvConf ctx+  pure $ ctx & (Ctx.network .~ True) . setResolvConf++ensureResolvConf :: Ctx.Context -> IO (Ctx.Context -> Ctx.Context)+ensureResolvConf ctx = case ctx ^. Ctx.runtimeCtx of+  -- When using host rootfs, then we need to mount /etc/resolv.conf target when it is a symlink+  Ctx.Bubblewrap "/" -> do+    symlink <- System.Posix.Files.isSymbolicLink <$> System.Posix.Files.getSymbolicLinkStatus "/etc/resolv.conf"+    if symlink+      then do+        realResolvConf <- getSymlinkPath+        pure $ Ctx.addMount realResolvConf $ Ctx.roHostPath realResolvConf+      else pure id+  -- Otherwise we can just mount it directly+  Ctx.Bubblewrap _ -> pure $ Ctx.addMount "/etc/resolv.conf" (Ctx.roHostPath "/etc/resolv.conf")+  _ -> pure id+  where+    getSymlinkPath = do+      realResolvConf <- System.Posix.Files.readSymbolicLink "/etc/resolv.conf"+      pure $+        if "../" `isPrefixOf` realResolvConf+          then drop 2 realResolvConf+          else realResolvConf++setTerminal :: Ctx.Context -> AppEnvT Ctx.Context+setTerminal ctx =+  pure $ ctx & (Ctx.interactive .~ True) . (Ctx.terminal .~ True) . (Ctx.addEnv "TERM" "xterm-256color")++setWayland :: Ctx.Context -> AppEnvT Ctx.Context+setWayland ctx = do+  sktM <- liftIO $ lookupEnv "WAYLAND_DISPLAY"+  case sktM of+    Nothing -> setX11 ctx+    Just skt -> setWayland' skt ctx++setWayland' :: FilePath -> Ctx.Context -> AppEnvT Ctx.Context+setWayland' skt ctx = do+  shareSkt <- addXdgRun skt+  pure $+    ctx+      & Ctx.directMount "/etc/machine-id"+        . shareSkt+        . Ctx.addEnv "GDK_BACKEND" "wayland"+        . Ctx.addEnv "QT_QPA_PLATFORM" "wayland"+        . Ctx.addEnv "WAYLAND_DISPLAY" (toText skt)+        . Ctx.addEnv "XDG_SESSION_TYPE" "wayland"+        . Ctx.addMount "/dev/shm" Ctx.tmpfs++setPipewire :: Ctx.Context -> AppEnvT Ctx.Context+setPipewire ctx = do+  let skt = "pipewire-0" -- TODO discover skt name+  shareSkt <- addXdgRun skt+  pure $+    ctx+      & Ctx.directMount "/etc/machine-id"+        . shareSkt++setDbus :: Ctx.Context -> AppEnvT Ctx.Context+setDbus ctx = do+  let skt = "bus" -- TODO discover skt name+  (sktPath, shareSkt) <- addXdgRun' skt+  pure $+    ctx+      & Ctx.directMount "/etc/machine-id"+        . Ctx.addEnv "DBUS_SESSION_BUS_ADDRESS" ("unix:path=" <> toText sktPath)+        . shareSkt++setVideo :: Ctx.Context -> AppEnvT Ctx.Context+setVideo ctx = do+  devices <- liftIO $ listDirectory "/dev"+  let addDevices =+        map (Ctx.addDevice . toString . mappend "/dev/") $+          filter ("video" `Text.isPrefixOf`) $ map toText devices+  pure $ foldr (\c a -> c a) ctx addDevices++setDri :: Ctx.Context -> AppEnvT Ctx.Context+setDri ctx = do+  nvidia <- liftIO $ doesPathExist "/dev/nvidiactl"+  pure $+    ctx+      & if nvidia+        then Ctx.addDevice "/dev/nvidiactl" . Ctx.addDevice "/dev/nvidia0"+        else Ctx.addDevice "/dev/dri"++setPulseaudio :: Ctx.Context -> AppEnvT Ctx.Context+setPulseaudio ctx = do+  shareSkt <- addXdgRun "pulse"+  uid <- asks _hostUid+  let pulseServer = "/run/user/" <> show uid <> "/pulse/native"+  pure $+    ctx+      & Ctx.directMount "/etc/machine-id"+        . shareSkt+        . Ctx.addEnv "PULSE_SERVER" pulseServer++getHomes :: Text -> AppEnvT (FilePath, FilePath)+getHomes help = do+  hostDir <- fromMaybe (error $ "Need HOME for " <> help) <$> asks _hostHomeDir+  appDir <- fromMaybe (error $ "Application need home for " <> help) <$> asks _appHomeDir+  pure (hostDir, appDir)++mountHomeConfig :: Text -> FilePath -> AppEnvT (Ctx.Context -> Ctx.Context)+mountHomeConfig help fp = do+  (hostDir, appDir) <- getHomes help+  pure $ Ctx.addMount (appDir </> fp) (Ctx.roHostPath $ hostDir </> fp)++setAgent :: String -> IO (Ctx.Context -> Ctx.Context)+setAgent var = do+  value <- lookupEnv var+  pure $ case value of+    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++setGpg :: Ctx.Context -> AppEnvT Ctx.Context+setGpg ctx = do+  shareConfig <- mountHomeConfig "gpg" ".gnupg"+  shareGpg <- addXdgRun "gnupg"+  pure $ ctx & shareGpg . shareConfig++setX11 :: Ctx.Context -> AppEnvT Ctx.Context+setX11 ctx = do+  display <- liftIO $ getEnv "DISPLAY"+  pure $+    ctx+      & Ctx.directMount "/tmp/.X11-unix" . Ctx.addEnv "DISPLAY" (toText display) . Ctx.addMount "/dev/shm" Ctx.tmpfs++setCwd :: Ctx.Context -> AppEnvT Ctx.Context+setCwd ctx = do+  cwd <- asks _hostCwd+  pure $ ctx & Ctx.addMount "/data" (Ctx.rwHostPath cwd) . (Ctx.workdir ?~ "/data")++addVolume :: Ctx.Context -> Text -> AppEnvT Ctx.Context+addVolume ctx volume = do+  containerPath' <- resolveContainerPath containerPath+  hostPath' <- resolveVolume hostPath+  pure $ Ctx.addMount containerPath' hostPath' ctx+  where+    (hostPath, containerPath) = case Text.breakOn ":" volume of+      (x, "") -> (x, x)+      (x, y) -> (x, Text.drop 1 y)++resolveFileArgs :: [Text] -> AppEnvT (Ctx.Context -> Ctx.Context)+resolveFileArgs args = do+  fps <- traverse checkExist args+  pure $ foldr ((.) . addFileArg) id fps+  where+    addCommand :: Text -> Ctx.Context -> Ctx.Context+    addCommand arg = Ctx.command %~ (arg :)+    checkExist :: Text -> AppEnvT (Either Text FilePath)+    checkExist arg = do+      fpM <- resolveHostPath arg+      case fpM of+        Nothing -> pure $ Left arg+        Just fp -> do+          exist <- liftIO $ doesPathExist fp+          unless exist (liftIO $ putTextLn $ "Warning, arg path does not exist: " <> arg)+          pure $ bool (Left arg) (Right fp) exist+    addFileArg :: Either Text FilePath -> Ctx.Context -> Ctx.Context+    addFileArg (Left arg) = addCommand arg+    addFileArg (Right fp)+      | hasTrailingPathSeparator fp = error "Directory filearg ar not supported"+      | otherwise =+        let cfp = "/data" </> takeFileName fp+         in addCommand (toText cfp) . Ctx.addMount cfp (Ctx.rwHostPath fp)++-- | Helper functions to manipulate paths+getXdgRuntimeDir :: AppEnvT FilePath+getXdgRuntimeDir = fromMaybe (error "Need XDG_RUNTIME_DIR") <$> asks _hostXdgRunDir++fixPath :: Text -> FilePath+fixPath = toString . Text.drop 1 . Text.dropWhile (/= '/')++resolveContainerPath :: Text -> AppEnvT FilePath+resolveContainerPath path+  | path == "~" || "~/" `Text.isPrefixOf` path = do+    appHome' <- fromMaybe (error "Need app home") <$> asks _appHomeDir+    pure $ appHome' </> fixPath path+  | "/" `Text.isPrefixOf` path = pure $ toString path+  | otherwise = error $ "Invalid container path: " <> path++resolveHostPath :: Text -> AppEnvT (Maybe FilePath)+resolveHostPath path+  | "~/" `Text.isPrefixOf` path = do+    envHome' <- fromMaybe (error "Need HOME") <$> asks _hostHomeDir+    pure $ Just (envHome' </> fixPath path)+  | "./" `Text.isPrefixOf` path = do+    curDir' <- asks _hostCwd+    pure $ Just (curDir' </> fixPath path)+  | "/" `Text.isPrefixOf` path = pure $ Just (toString path)+  | otherwise = pure Nothing++resolveHostPath' :: Text -> AppEnvT FilePath+resolveHostPath' path = do+  pathM <- resolveHostPath path+  case pathM of+    Just x -> pure x+    Nothing -> error $ "Invalid host path: " <> path++resolveVolume :: Text -> AppEnvT Ctx.Volume+resolveVolume name = case Text.uncons name of+  Nothing -> error "Empty host path"+  Just (x, _xs)+    -- TODO: handle suffix such as :Z+    | x `elem` ['~', '.', '/'] -> Ctx.rwHostPath <$> resolveHostPath' name+    | otherwise -> pure $ Ctx.MkVolume Ctx.RW (Ctx.Volume name)++-- | Helper function to share a XDG_RUNTIME_DIR path+addXdgRun :: FilePath -> AppEnvT (Ctx.Context -> Ctx.Context)+addXdgRun fp = snd <$> addXdgRun' fp++-- | Returns the container path and the context setter for xdg+addXdgRun' :: FilePath -> AppEnvT (FilePath, Ctx.Context -> Ctx.Context)+addXdgRun' fp = do+  hostXdg <- getXdgRuntimeDir+  uid <- asks _hostUid+  let containerPath = runDir </> fp+      hostPath = hostXdg </> fp+      runBaseDir = "/run/user"+      runDir = runBaseDir <> "/" <> show uid+  pure+    ( containerPath,+      Ctx.addEnv "XDG_RUNTIME_DIR" (toText runDir)+        -- Podman creates parent directory as root, ensure user can r/w xdgdir using tmpfs+        . Ctx.addMount runBaseDir Ctx.tmpfs+        . Ctx.addMount containerPath (Ctx.rwHostPath hostPath)+    )++-- | Helper for capabilities that are directly represented in the context+contextSet :: Lens' Ctx.Context a -> a -> Ctx.Context -> AppEnvT Ctx.Context+contextSet lens value ctx = pure ((lens .~ value) ctx)
+ src/Podenv/Build.hs view
@@ -0,0 +1,237 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE NoImplicitPrelude #-}++-- | This modules contains logic to perform application runtime build+module Podenv.Build+  ( prepare,+    BuildEnv (..),+    containerBuildRuntime,+    nixRuntime,+  )+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 Podenv.Dhall+import Podenv.Prelude+import Podenv.Runtime (ImageName (..))+import qualified Podenv.Runtime+import System.Directory (doesDirectoryExist, renameFile)+import System.Exit (ExitCode (ExitSuccess))+import qualified System.Process.Typed as P++-- | Helper function to run a standalone app, usefull for local build+type AppRunner = Application -> IO ()++-- | A build env contains action to be performed before preparation and execution+data BuildEnv = BuildEnv+  { beInfos :: Text,+    -- | Builds the runtime+    beEnsure :: AppRunner -> IO (),+    -- | Updates the runtime+    beUpdate :: AppRunner -> IO ()+  }++defaultBuildEnv :: Text -> BuildEnv+defaultBuildEnv beInfos = BuildEnv {..}+  where+    beEnsure = const $ pure ()+    beUpdate = const $ pure ()++-- | 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)+  Nix expr -> prepareNix re app expr++containerBuildRuntime :: ContainerBuild -> Podenv.Runtime.RuntimeContext+containerBuildRuntime = Podenv.Runtime.Container . mkImageName++mkImageName :: ContainerBuild -> ImageName+mkImageName containerBuild = ImageName $ "localhost/" <> name+  where+    -- The image name can be set by the container build,+    -- otherwise it default to the Containerfile hash+    name = fromMaybe imageHash (containerBuild ^. cbImage_name)+    imageHash = toText . SHA.showDigest . SHA.sha256 . encodeUtf8 $ containerBuild ^. cbContainerfile++-- | Container build env+prepareContainer :: ContainerBuild -> BuildEnv+prepareContainer containerBuild = BuildEnv {..}+  where+    -- buildenv basic info:+    beInfos = "# Containerfile " <> imageName <> "\n" <> fileContent+    fileContent = containerBuild ^. cbContainerfile++    ImageName imageName = mkImageName containerBuild+    fileName = "Containerfile_" <> toString (imageNameToFP imageName)+      where+        imageNameToFP = Text.replace "/" "_" . Text.replace ":" "-"++    beEnsure = const $ do+      imageReady <- checkImageExist imageName+      unless imageReady $+        buildImage imageName fileName fileContent (containerBuild ^. cbImage_volumes)++    beUpdate = const $ case containerBuild ^. cbImage_update of+      Nothing -> error "The container is missing the `image_update` attribute"+      Just cmd -> do+        buildImage+          imageName+          (fileName <> "-update")+          (unlines ["FROM " <> imageName, "RUN " <> cmd])+          (containerBuild ^. cbImage_volumes)++-- | Nix runtime re-use the host root filesystem, prepareNix added the nix-store volume.+nixRuntime :: Podenv.Runtime.RuntimeContext+nixRuntime = Podenv.Runtime.Bubblewrap "/"++getCertLocation :: IO (Maybe FilePath)+getCertLocation = runMaybeT $ Control.Monad.msum $ checkPath <$> paths+  where+    checkPath :: FilePath -> MaybeT IO FilePath+    checkPath fp = do+      exist <- lift $ doesPathExist fp+      unless exist mzero+      pure fp+    -- Copied from profile.d/nix.sh+    paths =+      [ "/etc/pki/tls/certs/ca-bundle.crt",+        "/etc/ssl/certs/ca-certificates.crt",+        "/etc/ssl/ca-bundle.pem",+        "/etc/ssl/certs/ca-bundle.crt"+      ]++-- | Nix build env+prepareNix :: Podenv.Runtime.RuntimeEnv -> Application -> Flakes -> IO (BuildEnv, Application)+prepareNix re app flakes = do+  certs <- toText . fromMaybe (error "Can't find ca-bundle") <$> getCertLocation+  -- TODO: check howto re-use the host /nix+  pure+    ( BuildEnv+        { beInfos = "# Nix expr:\n" <> Text.unwords nixArgs,+          beEnsure = beEnsure certs,+          beUpdate = const $ error "Nix update is not implemented"+        },+      updateApp certs app+    )+  where+    name = app ^. appName+    fileName = toString $ "nix_" <> name++    -- The location where we expect to find the `nix` command+    nixStore = Podenv.Runtime.volumesDir re </> "nix-store"+    nixCommandProfile = "var/nix/profiles/nix-install"+    nixCommandPath = "/nix/" <> nixCommandProfile <> "/bin/nix"+    nixFlags = ["--extra-experimental-features", "nix-command flakes"]++    -- The nix command args+    nixExtraArgs = case nixpkgs flakes of+      Just pin | not (all (Text.isPrefixOf pin) (installables flakes)) -> ["--override-input", "nixpkgs", pin]+      _ -> []+    nixArgs = nixExtraArgs <> installables flakes++    beEnsure certs runApp = do+      built <- checkIfBuilt fileName (show nixArgs)+      unless built $ do+        ensureNixInstalled+        _ <- runApp (buildApp certs)++        -- save that the build succeeded+        cacheDir <- getCacheDir+        Text.writeFile (cacheDir </> fileName) (show nixArgs)++    debug = when (Podenv.Runtime.verbose re) . hPutStrLn stderr . mappend "[+] "++    ensureNixInstalled = do+      debug $ "Checking if " <> nixStore </> nixCommandProfile <> " exists"+      nixInstalled <- doesSymlinkExist $ nixStore </> nixCommandProfile+      unless nixInstalled $ do+        debug $ "Checking if " <> nixStore </> "store" <> " exists"+        storeExist <- doesDirectoryExist $ nixStore </> "store"+        when storeExist $ error $ "existing nix-store is invalid, try removing " <> toText nixStore++        podenv <- getExecutablePath+        debug $ "[+] Installing nix-store with " <> podenv <> " nix.setup"+        P.runProcess_ $ P.setDelegateCtlc True $ P.proc podenv ["nix.setup"]++    -- The Application to build the expression, it is executed in advance to separate build and execution+    buildApp certs =+      Podenv.Config.defaultApp+        { runtime = Rootfs "/",+          name = "build-" <> name,+          volumes = [toText nixStore <> ":/nix", "nix-setup-home:~/", "nix-cache:~/.cache/nix"],+          environ = ["NIX_SSL_CERT_FILE=" <> certs, "LC_ALL=C.UTF-8", "TERM=xterm"],+          command =+            [toText nixCommandPath, "--verbose"]+              <> nixFlags+              <> ["build", "--no-link"]+              <> nixArgs+        }+        & (appCapabilities . capNetwork .~ True)++    runCommand =+      [toText nixCommandPath] <> nixFlags <> case app ^. appCommand of+        [] -> ["run"] <> nixArgs+        appArgs -> ["shell"] <> nixArgs <> ["--command"] <> appArgs+    addCommand = appCommand .~ runCommand+    addVolumes = appVolumes %~ mappend ["nix-store:/nix", "nix-cache:~/.cache/nix"]+    addEnvirons certs =+      appEnviron+        %~ mappend+          [ "NIX_SSL_CERT_FILE=" <> certs,+            "TERM=xterm",+            "LC_ALL=C.UTF-8",+            "PATH=/nix/var/nix/profiles/nix-install/bin:/bin"+          ]+    updateApp certs = addCommand . addVolumes . addEnvirons certs++-- | Build a container image+buildImage :: Text -> FilePath -> Text -> [Text] -> IO ()+buildImage imageName fileName containerfile volumes = do+  uid <- getRealUserID+  cacheDir <- getCacheDir+  createDirectoryIfMissing True cacheDir+  let want = fileName <> ".want"+      wantfp = cacheDir </> want+  Text.writeFile wantfp containerfile+  -- podman build does not support regular volume, lets ensure absolute path+  volumesArgs <- traverse (mkVolumeArg cacheDir) volumes+  let buildArgs =+        ["build"]+          <> ["-t", toString imageName]+          <> ["--build-arg", "USER_UID=" <> show uid]+          <> map toString volumesArgs+          <> ["-f", want, cacheDir]+      cmd = Podenv.Runtime.podman buildArgs+  -- putTextLn $ "Building " <> imageName <> " with " <> toText want <> ": " <> show cmd+  P.runProcess_ cmd++  -- save that the build succeeded+  renameFile wantfp (cacheDir </> fileName)+  where+    mkVolumeArg :: FilePath -> Text -> IO Text+    mkVolumeArg cacheDir volume = do+      createDirectoryIfMissing True hostPath+      pure $ "-v=" <> toText hostPath <> ":" <> containerPath <> ":Z"+      where+        (p1, p2) = Text.break (== ':') volume+        hostPath = cacheDir </> toString p1+        containerPath = Text.drop 1 p2++checkImageExist :: Text -> IO Bool+checkImageExist imageName = do+  res <- P.runProcess (Podenv.Runtime.podman ["image", "exists", Text.unpack imageName])+  pure $ res == ExitSuccess++checkIfBuilt :: FilePath -> Text -> IO Bool+checkIfBuilt filename expected = do+  cacheDir <- getCacheDir+  current <- readFileM (cacheDir </> filename)+  pure $ current == expected
+ src/Podenv/Config.hs view
@@ -0,0 +1,345 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoImplicitPrelude #-}++-- | This module contains the logic to load the dhall configuration+module Podenv.Config+  ( load,+    select,+    Config (..),+    Atom (..),+    ApplicationRecord (..),+    defaultConfigPath,+    defaultApp,+    loadSystem,+    defaultSystemConfig,+    podenvImportTxt,+  )+where++import Control.Exception (bracket_)+import qualified Data.Digest.Pure.SHA 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 Dhall.Marshal.Decode (DhallErrors (..), extractError)+import qualified Dhall.Parser+import qualified Dhall.Src+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++data Config+  = -- | A standalone application, e.g. defaultSelector+    ConfigDefault ApplicationRecord+  | -- | A single application+    ConfigApplication Atom+  | -- | A collection of applications+    ConfigApplications [(Text, Atom)]++data Atom+  = -- | A literal application+    Lit ApplicationRecord+  | -- | A paremeterized application+    LamArg ArgName (Text -> ApplicationRecord)+  | LamArg2 ArgName ArgName (Text -> Text -> ApplicationRecord)+  | -- | A functional application+    LamApp (Application -> ApplicationRecord)++-- | A wrapper around the true Application type to manage weakly typed configuration+-- (e.g. so that `{ runtime.image = "ubi8" }` can be manually decoded)+newtype ApplicationRecord = ApplicationRecord {unRecord :: Application}++instance Dhall.FromDhall ApplicationRecord where+  autoWith = const appRecordDecoder++newtype ArgName = ArgName Text++instance Text.Show.Show ArgName where+  show (ArgName n) = toString n++-- | Config load entrypoint+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++defaultSelector :: Text -> Maybe Application+defaultSelector s+  | "image:" `Text.isPrefixOf` s = imageApp s+  | "nix:" `Text.isPrefixOf` s = nixApp s+  | "nixpkgs#" `Text.isPrefixOf` s = nixApp' s+  | "rootfs:" `Text.isPrefixOf` s = rootfsApp s+  | otherwise = Nothing+  where+    imageApp x = mkApp ("image-" <> mkName x) (Image $ Text.drop (Text.length "image:") x)+    nixApp' x = mkApp ("nix-" <> mkName x) (Nix $ Flakes [x] Nothing)+    nixApp x = nixApp' $ Text.drop (Text.length "nix:") x+    rootfsApp x = mkApp ("rootfs-" <> mkName x) (Rootfs $ Text.drop (Text.length "rootfs:") x)+    mkApp name runtime' = Just $ defaultApp & (appName .~ name) . (appRuntime .~ runtime')+    mkName = Text.take 6 . toText . SHA.showDigest . SHA.sha1 . encodeUtf8++-- | Inject the package.dhall into the environ so that config can use `env:PODENV`+loadWithEnv :: FilePath -> Dhall.Expr Dhall.Src.Src Dhall.Import -> IO DhallExpr+loadWithEnv baseDir expr = withEnv $ flip evalStateT initialState $ Dhall.Import.loadWith expr+  where+    -- Set the PODENV environment variable to the frozen url of the current hub+    withEnv = bracket_ (setEnv "PODENV" (toString podenvImportTxt)) (unsetEnv "PODENV")+    -- Then use a custom Dhall.Import.Status state that inject the static code+    -- The goal is to only pretty print (text encode) the package when the cache is cold+    initialState = baseStatus & Dhall.Import.remote .~ fetchUrl+    baseStatus = Dhall.Import.emptyStatus baseDir+    fetchUrl url+      | url == podenvUrl = pure (Dhall.pretty podenvPackage)+      | otherwise = (baseStatus ^. Dhall.Import.remote) url++-- | Helper function to parse the initial configuration+loadExpr :: Maybe Text -> IO DhallExpr+loadExpr configM = case configM of+  Just configTxt -> do+    cwd' <- getCurrentDirectory+    loadWithEnv cwd' $ exprFromText' configTxt+  Nothing -> do+    baseDir <- getConfigDir+    let configPath = baseDir </> "config.dhall"++    -- load main config+    configContent <-+      bool (pure "(env:PODENV).Hub") (Text.readFile configPath) =<< doesFileExist configPath+    let configExpr = exprFromText' configContent++    -- lookup local.d configs+    let locald = baseDir </> "local.d"+    localFiles <- bool (pure []) (listDirectory locald) =<< doesPathExist locald+    let localConfig = createLocalRecord locald localFiles++    -- adds local.d to the main config using the `//` operator+    let expr' = Dhall.Prefer Nothing Dhall.PreferFromSource configExpr localConfig+    loadWithEnv baseDir expr'+  where+    exprFromText' :: Text -> Dhall.Expr Dhall.Src.Src Dhall.Import+    exprFromText' configTxt = case Dhall.Parser.exprFromText "<config>" configTxt of+      Right expr -> expr+      Left e -> error $ "Invalid config: " <> show e++-- | Create a record for local.d config+createLocalRecord :: FilePath -> [FilePath] -> Dhall.Expr Dhall.Src.Src Dhall.Import+createLocalRecord baseDir =+  Dhall.RecordLit . fromList . map toRecord . filter (isExtensionOf ".dhall")+  where+    toRecord :: FilePath -> (Text, Dhall.RecordField Dhall.Src.Src Dhall.Import)+    toRecord name = (toText $ dropExtension name, Dhall.makeRecordField (Dhall.Embed $ toImport name))+    toImport :: FilePath -> Dhall.Import+    toImport name =+      let file = Dhall.File (Dhall.Directory $ reverse $ map toText $ splitPath baseDir) (toText name)+       in Dhall.Import (Dhall.ImportHashed Nothing (Dhall.Local Dhall.Absolute file)) Dhall.Code++-- | The static hub package expression+podenvUrl :: Dhall.URL+podenvUrl =+  Dhall.URL Dhall.HTTPS "raw.githubusercontent.com" path Nothing Nothing+  where+    hubVersion = case Dhall.extract Dhall.auto (Dhall.renote hubCommit) of+      Success x -> Text.dropEnd 1 x+      Failure v -> error $ "Unknown hub commit: " <> show v+    path = Dhall.File (Dhall.Directory [hubVersion, "hub", "podenv"]) "package.dhall"++podenvImport :: Dhall.Import+podenvImport =+  Dhall.Import (Dhall.ImportHashed (Just hash) (Dhall.Remote podenvUrl)) Dhall.Code+  where+    hash = Dhall.Import.hashExpression (Dhall.alphaNormalize podenvPackage)++podenvImportTxt :: Text+podenvImportTxt = Text.replace "\n " "" $ Dhall.pretty podenvImport++-- | Pure config load+load' :: DhallExpr -> Config+load' expr = case loadConfig "" expr of+  Success [(selector, Lit app)] -> ConfigApplication $ Lit (ensureName selector app)+  Success [(_, x)] -> ConfigApplication x+  Success [] -> error "No application found"+  Success xs -> ConfigApplications xs+  Failure (DhallErrors (x :| _)) -> error $ show x++-- | When an application doesn't have a name, set it to the selector path+ensureName :: Text -> ApplicationRecord -> ApplicationRecord+ensureName x app = case unRecord app ^. appName of+  "" -> ApplicationRecord $ unRecord app & appName .~ x+  _ -> app++-- | The main config load function. It recursively descend the+-- tree by extending the selector name.+loadConfig :: Text -> DhallExpr -> DhallParser [(Text, Atom)]+loadConfig baseSelector expr = case expr of+  -- When the node is a function, assume it is an app.+  Dhall.Lam {} -> (\app -> [(baseSelector, app)]) <$> loadApp expr+  Dhall.RecordLit kv+    | -- When the node has a "runtime" attribute, assume it is an app.+      DM.member "runtime" kv ->+      (\app -> [(baseSelector, app)]) <$> loadApp expr+    | -- Otherwise, traverse each attributes+      otherwise ->+      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:+        -- FromDhall: You cannot decode a function if it does not have the correct type+        | "use" `Text.isPrefixOf` n = pure []+        | otherwise = loadConfig (mkSelector n) (Dhall.recordFieldValue e)+      mkSelector name+        | baseSelector == mempty = name+        | name == "default" = baseSelector+        | otherwise = baseSelector <> "." <> name+  _ -> extractError $ baseSelector <> ": expected a record literal, but got: " <> Text.take 256 (show expr)++-- | Select the application, returning the unused cli args.+select :: Config -> [Text] -> Either Text ([Text], Application)+select config args = fmap unRecord <$> select' config args++select' :: Config -> [Text] -> Either Text ([Text], ApplicationRecord)+select' config args = case config of+  -- config default is always selected, drop the first args+  ConfigDefault app -> pure (tail (fromList args), app)+  -- config has only one application, don't touch the args+  ConfigApplication atom -> selectApp [] args atom+  -- config has some applications, the first arg is a selector+  ConfigApplications atoms -> case args of+    (selector : xs) -> do+      atom <- lookup selector atoms `orDie` (selector <> ": not found")+      (args', app) <- selectApp atoms xs atom+      let name' = Text.intercalate "-" $ take (length args - length args') args+      pure (args', ensureName name' app)+    [] -> Left "Multiple apps configured, provides a selector"+  where+    selectApp atoms args' atom = case atom of+      -- App is not a function, don't touch the arg+      Lit app -> pure (args', app)+      -- App needs an argument, the tail is the arg+      LamArg arg f -> case args' of+        (x : xs) -> pure (xs, f x)+        [] -> Left ("Missing argument: " <> show arg)+      LamArg2 arg1 arg2 f -> case args' of+        (x : y : xs) -> pure (xs, f x y)+        (_ : _) -> Left ("Missing argument: " <> show arg2)+        _ -> Left ("Missing arguments: " <> show arg1 <> " " <> show arg2)+      LamApp f -> case args' of+        (x : xs) -> case defaultSelector x of+          Just app -> pure (xs, f app)+          Nothing -> do+            -- Recursively select the app to eval arg `mod app arg` as `mod (app arg)`+            -- e.g. LamApp should be applied at the end.+            atom' <- lookup x atoms `orDie` (x <> ": unknown lam arg")+            (rest, app) <- selectApp atoms xs atom'+            pure (rest, f (unRecord app))+        [] -> Left "Missing app argument"++defaultConfigPath :: Text+defaultConfigPath = "~/.config/podenv/config.dhall"++-- | The default app+defaultApp :: Application+defaultApp = case Dhall.extract Dhall.auto (Dhall.renote appDefault) of+  Success app -> app+  Failure v -> error $ "Invalid default application: " <> show v++-- | A type synonym to simplify function annotation.+type DhallParser a = Dhall.Extractor Dhall.Src.Src Void a++-- | A type synonym to simplify function annotation.+type DhallExpr = Dhall.Expr Dhall.Src.Src Void++type DhallExtractor a = Dhall.Extractor Dhall.Src.Src Void a++-- | The `//` dhall record update operation+pref :: Dhall.Expr s a -> Dhall.Expr s a -> Dhall.Expr s a+pref = Dhall.Prefer Nothing Dhall.PreferFromSource++mkRecord :: [(Text, Dhall.Expr s a)] -> Dhall.Expr s a+mkRecord kv = Dhall.RecordLit (Dhall.makeRecordField <$> DM.fromList kv)++recordItems :: DM.Map Text (Dhall.RecordField s a) -> [(Text, Dhall.Expr Void a)]+recordItems kv = fmap (Dhall.denote . Dhall.recordFieldValue) <$> DM.toList kv++-- | A custom Dhall Decoder that can convert a weakly type Application+-- This is done by modifying the 'base' Dhall.Expr with:+--   App.default // (base // { capabilities = Caps.default // base.capabilities })+-- so that the missing fields are automatically added.+--+-- For the runtime value, this convert may convert a tag record to an Union variant+appRecordDecoder :: Dhall.Decoder ApplicationRecord+appRecordDecoder = ApplicationRecord <$> Dhall.Decoder extract expected+  where+    extract :: Dhall.Expr Dhall.Src.Src Void -> DhallExtractor Application+    extract (Dhall.RecordLit kv) = case DM.lookup "runtime" kv of+      Just (Dhall.RecordField _ (Dhall.RecordLit kv') _ _) -> extract' kv (runtimeFromRecord kv')+      Just (Dhall.RecordField _ v _ _) -> extract' kv (Dhall.denote v)+      Nothing -> Dhall.extractError "Application does not have a runtime"+    extract _ = Dhall.extractError "Application is not a record"++    runtimeFromRecord :: DM.Map Text (Dhall.RecordField s Void) -> Dhall.Expr Void Void+    runtimeFromRecord kv = case recordItems kv of+      [("image", x)] -> mkRuntime "Image" x+      [("nix", x)] -> mkRuntime "Nix" (mkNixRecord x)+      [("containerfile", x)] -> mkRuntime "Container" (pref containerBuildDefault (mkRecord [("containerfile", x)]))+      _ -> mkRuntime "Container" (pref containerBuildDefault (Dhall.denote (Dhall.RecordLit kv)))+      where+        mkNixRecord v =+          mkRecord+            [ ("installables", Dhall.ListLit Nothing $ fromList [v]),+              ("nixpkgs", Dhall.App Dhall.None Dhall.Text)+            ]+        mkRuntime field v =+          Dhall.App (Dhall.Field runtimeType (Dhall.FieldSelection Nothing field Nothing)) v++    extract' :: DM.Map Text (Dhall.RecordField s Void) -> Dhall.Expr Void Void -> DhallExtractor Application+    extract' kv runtimeExpr =+      let capsExpr = case DM.lookup "capabilities" kv of+            Just (Dhall.RecordField _ v _ _) -> pref capsDefault (Dhall.denote v)+            _ -> capsDefault++          -- capabilities and runtime are always added since they are nested schemas+          nestedSchemas = [("capabilities", capsExpr), ("runtime", runtimeExpr)]++          baseExpr = pref (Dhall.denote $ Dhall.RecordLit kv) (mkRecord nestedSchemas)+          expr = pref appDefault baseExpr++          -- The generic Application decoder+          Dhall.Decoder appDecoder _ = Dhall.genericAuto+       in appDecoder (Dhall.renote (Dhall.normalize expr))++    expected = Success (Dhall.renote appType)++-- | Parse and tag a DhallExpr with an Atom constructor+loadApp :: DhallExpr -> DhallParser Atom+loadApp expr = case expr of+  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+    | otherwise -> LamArg (getArgName fb) <$> Dhall.extract Dhall.auto expr+  _ -> Lit <$> Dhall.extract Dhall.auto expr+  where+    getArgName = ArgName . Dhall.functionBindingVariable++loadSystem :: IO SystemConfig+loadSystem = do+  confDir <- getXdgDirectory XdgConfig "podenv"+  let fp = confDir </> "system.dhall"+  exist <- doesFileExist fp+  if exist+    then Dhall.input Dhall.auto (toText fp)+    else pure defaultSystemConfig++-- | The default system config+defaultSystemConfig :: SystemConfig+defaultSystemConfig = case Dhall.extract Dhall.auto (Dhall.renote systemConfigDefault) of+  Success x -> x+  Failure v -> error $ "Invalid default system config: " <> show v
+ src/Podenv/Context.hs view
@@ -0,0 +1,135 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+-- makeLenses does not produce those+{-# OPTIONS_GHC -Wno-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-missing-export-lists #-}++-- | Runtime Context data types and lenses+module Podenv.Context where++import qualified Data.Map.Strict as Map+import qualified Data.Set as Set+import Lens.Family.TH (makeLenses)+import Podenv.Prelude+import System.Linux.Capabilities (Capability)++newtype ImageName = ImageName {unImageName :: Text}+  deriving (Show)++data RuntimeContext+  = Container ImageName+  | Bubblewrap FilePath+  deriving (Show)++data Mode = RO | RW+  deriving (Show)++data VolumeType = HostPath FilePath | TmpFS | Volume Text+  deriving (Show)++data Volume = MkVolume Mode VolumeType+  deriving (Show)++data RunAs = RunAsRoot | RunAsHostUID | RunAsAnyUID+  deriving (Show)++data Port = PortTcp Natural | PortUdp Natural+  deriving (Show)++newtype Name = Name {unName :: Text}+  deriving (Show)++-- | The application context to be executed by podman or kubectl+data Context = Context+  { -- | identifier+    _name :: Name,+    _namespace :: Maybe Text,+    -- | container image name+    _runtimeCtx :: RuntimeContext,+    -- | network namespace name+    _network :: Bool,+    _ports :: [Port],+    _runAs :: Maybe RunAs,+    _selinux :: Bool,+    -- | the unique uid for this container+    _anyUid :: UserID,+    -- | host uid+    _uid :: UserID,+    -- | container command+    _command :: [Text],+    _workdir :: Maybe FilePath,+    -- | container env+    _environ :: Map Text Text,+    -- | container volumes+    _mounts :: Map FilePath Volume,+    _syscaps :: [Capability],+    _ro :: Bool,+    -- | container devices+    _devices :: Set FilePath,+    _hostname :: Maybe Text,+    _interactive :: Bool,+    _terminal :: Bool,+    _privileged :: Bool+  }+  deriving (Show)++$(makeLenses ''Context)++defaultContext :: Name -> RuntimeContext -> Context+defaultContext _name _runtimeCtx =+  Context+    { _name,+      _runtimeCtx,+      _command = [],+      _uid = 0,+      _namespace = Nothing,+      -- todo keep track of fresh uid+      _anyUid = 4242,+      _selinux = True,+      _network = False,+      _ports = mempty,+      _runAs = Nothing,+      _environ = mempty,+      _mounts = mempty,+      _devices = mempty,+      _syscaps = mempty,+      -- TODO: make ro work for podman+      _ro = True,+      _workdir = Nothing,+      _hostname = Nothing,+      _interactive = False,+      _terminal = False,+      _privileged = False+    }++rwHostPath :: FilePath -> Volume+rwHostPath = MkVolume RW . HostPath++roHostPath :: FilePath -> Volume+roHostPath = MkVolume RO . HostPath++tmpfs :: Volume+tmpfs = MkVolume RW TmpFS++-- Env and mounts head value takes priority+addEnv :: Text -> Text -> Context -> Context+addEnv k v = environ %~ Map.insertWith (\_n o -> o) k v++addMount :: FilePath -> Volume -> Context -> Context+addMount containerPath hostPath = mounts %~ Map.insertWith (\_n o -> o) containerPath hostPath++directMount :: FilePath -> Context -> Context+directMount fp = addMount fp (rwHostPath fp)++addDevice :: FilePath -> Context -> Context+addDevice dev = devices %~ Set.insert dev
+ src/Podenv/Dhall.hs view
@@ -0,0 +1,89 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+-- makeLenses does not produce those+{-# OPTIONS_GHC -Wno-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-missing-export-lists #-}++-- | This module defines Haskell data types and lenses for the podenv dhall schemas.+module Podenv.Dhall where++import Data.Char (toUpper)+import Data.Void+import Dhall.Core (Expr ())+import qualified Dhall.TH+import Lens.Family.TH (makeLensesBy)++-- | The hub submodule commit, this is only used for the PODENV environment value+hubCommit :: Expr Void Void+hubCommit = $(Dhall.TH.staticDhallExpression "env:HUB_COMMIT as Text ? ./.git/modules/hub/HEAD as Text")++-- | Embed static dhall code+podenvPackage :: Expr Void Void+podenvPackage = $(Dhall.TH.staticDhallExpression "./hub/package.dhall")++appType, appDefault, runtimeType, containerBuildDefault :: Expr Void Void+appType = $(Dhall.TH.staticDhallExpression "(./hub/schemas/Application.dhall).Type")+runtimeType = $(Dhall.TH.staticDhallExpression "./hub/schemas/Runtime.dhall")+containerBuildDefault = $(Dhall.TH.staticDhallExpression "(./hub/schemas/ContainerBuild.dhall).default")+appDefault =+  $( let package = "(./hub/schemas/package.dhall)"+      in Dhall.TH.staticDhallExpression (package <> ".Application.default // { runtime = " <> package <> ".Image \"\" }")+   )++capsDefault :: Expr Void Void+capsDefault = $(Dhall.TH.staticDhallExpression "(./hub/schemas/Capabilities.dhall).default")++systemConfigDefault :: Expr Void Void+systemConfigDefault = $(Dhall.TH.staticDhallExpression "(./hub/schemas/System.dhall).default")++-- | Generate Haskell Types from Dhall Types.+-- See: https://hackage.haskell.org/package/dhall-1.39.0/docs/Dhall-TH.html+Dhall.TH.makeHaskellTypes+  ( let mainPath name = "(./hub/schemas/" <> name <> ".dhall).Type"+        main' cname name = Dhall.TH.SingleConstructor cname cname $ mainPath name+        main name = main' name name+     in [ main "Capabilities",+          main "Application",+          main "ContainerBuild",+          main "Flakes",+          main' "SystemConfig" "System",+          Dhall.TH.MultipleConstructors "Runtime" "./hub/schemas/Runtime.dhall"+        ]+  )++$(makeLensesBy (\n -> Just $ "cap" <> [toUpper $ head n] <> tail n) ''Capabilities)++$(makeLensesBy (\n -> Just $ "app" <> [toUpper $ head n] <> tail n) ''Application)++$(makeLensesBy (\n -> Just $ "cb" <> [toUpper $ head n] <> tail n) ''ContainerBuild)++deriving instance Show Runtime++deriving instance Eq Runtime++deriving instance Show ContainerBuild++deriving instance Eq ContainerBuild++deriving instance Show Flakes++deriving instance Eq Flakes++deriving instance Show Capabilities++deriving instance Eq Capabilities++deriving instance Show Application++deriving instance Eq Application++$(makeLensesBy (\n -> Just $ "sys" <> [toUpper $ head n] <> tail n) ''SystemConfig)++deriving instance Show SystemConfig++deriving instance Eq SystemConfig
+ src/Podenv/Env.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# OPTIONS_GHC -Wno-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-missing-export-lists #-}++-- | The platform environment+module Podenv.Env where++import qualified Data.List.NonEmpty+import qualified Data.Maybe+import qualified Data.Text+import Lens.Family.TH (makeLenses)+import Podenv.Prelude++data AppEnv = AppEnv+  { _hostXdgRunDir :: Maybe FilePath,+    _hostHomeDir :: Maybe FilePath,+    _hostCwd :: FilePath,+    _hostUid :: UserID,+    _appHomeDir :: Maybe FilePath,+    _rootfsHome :: FilePath -> IO (Maybe FilePath)+  }++$(makeLenses ''AppEnv)++type AppEnvT a = ReaderT AppEnv IO a++-- | Get the current uid home path in the rootfs+getRootfsHome :: UserID -> Maybe FilePath -> FilePath -> IO (Maybe FilePath)+getRootfsHome _ (Just hostHome) "/" = pure $ Just hostHome+getRootfsHome uid _ fp = do+  passwd <- readFileM (fp </> "etc/passwd")+  pure $+    toString . Data.List.NonEmpty.head+      <$> Data.List.NonEmpty.nonEmpty (Data.Maybe.mapMaybe isUser $ Podenv.Prelude.lines passwd)+  where+    isUser l = case Data.Text.splitOn ":" l of+      (_ : _ : uid' : _ : _ : home : _) | readMaybe (toString uid') == Just uid -> Just home+      _ -> Nothing++new :: IO AppEnv+new = do+  uid <- getRealUserID+  home <- lookupEnv "HOME"+  AppEnv+    <$> lookupEnv "XDG_RUNTIME_DIR"+    <*> pure home+    <*> getCurrentDirectory+    <*> pure uid+    <*> pure Nothing+    <*> pure (getRootfsHome uid home)
+ src/Podenv/Main.hs view
@@ -0,0 +1,249 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE NoImplicitPrelude #-}++-- | This module contains the podenv CLI entrypoint+-- The workflow is: Main -> Config -> Build -> Application -> Context+--+-- * Main: select the app and override with command line arguments+-- * Config: load the configuration and select the application+-- * Build: optional application build+-- * App: convert application and capability into a Context+-- * Runtime: execute with podman or kubernetes+module Podenv.Main+  ( main,+    runApp,++    -- * exports for tests+    usage,+    cliConfigLoad,+    cliInfo,+    cliPrepare,+    CLI (..),+  )+where++import qualified Data.Text+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.Dhall+import Podenv.Prelude+import Podenv.Runtime (Context, Name (..), RuntimeEnv (..))+import qualified Podenv.Runtime+import qualified Podenv.Version (version)++-- | podenv entrypoint+main :: IO ()+main = do+  cli@CLI {..} <- usage =<< getArgs+  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++  if showApplication+    then putTextLn $ showApp app ctx be re+    else do+      Podenv.Build.beEnsure be (runApp re)+      when update $ Podenv.Build.beUpdate be (runApp re)+      Podenv.Runtime.execute re ctx++-- | 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)+  Podenv.Runtime.execute re ctx++usage :: [String] -> IO CLI+usage args = do+  cli <- handleParseResult $ execParserPure defaultPrefs cliInfo cliArgs+  pure $ cli {extraArgs = map toText appArgs}+  where+    cliArgs = takeCliArgs [] args+    appArgs = case drop (length cliArgs) args of+      -- Drop any `--` prefix+      ("--" : rest) -> rest+      xs -> xs++    -- Collect args until the selector, the rest should not be passed to optparse-applicative+    isPodenvArg arg+      | arg `elem` strOptions || "--bash-completion-" `isPrefixOf` arg = True+      | otherwise = False+    takeCliArgs acc args' = case args' of+      [] -> reverse acc+      -- Handle toggle such as `"--name" : "app-name" : _`+      (toggle : x : xs) | isPodenvArg toggle -> takeCliArgs (x : toggle : acc) xs+      (x : xs)+        -- `--` is a hard separator, stop now.+        | "--" == x -> takeCliArgs acc []+        -- this is switch, keep on taking+        | "--" `isPrefixOf` x -> takeCliArgs (x : acc) xs+        -- otherwise the selector is found, stop now+        | otherwise -> takeCliArgs (x : acc) []++data CLI = CLI+  { -- action modes:+    listApps :: Bool,+    listCaps :: Bool,+    showDhallEnv :: Bool,+    showApplication :: Bool,+    configExpr :: Maybe Text,+    -- runtime env:+    update :: Bool,+    verbose :: 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],+    selector :: Maybe Text,+    extraArgs :: [Text]+  }++-- WARNING: when adding strOption, update the 'strOptions' list+cliParser :: Parser CLI+cliParser =+  CLI+    -- action modes:+    <$> switch (long "list" <> help "List available applications")+    <*> switch (long "list-caps" <> help "List available capabilities")+    <*> 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")+    -- app modifiers:+    <*> capsParser+    <*> switch (long "shell" <> help "Start a shell instead of the application command")+    <*> optional (strOption (long "namespace" <> help "Share a network ns"))+    <*> optional (strOption (long "name" <> metavar "NAME" <> help "Container name"))+    <*> many (strOption (long "env" <> metavar "ENV" <> help "Extra env 'KEY=VALUE'"))+    <*> many (strOption (long "volume" <> short 'v' <> metavar "VOLUME" <> help "Extra volumes 'volume|hostPath[:containerPath]'"))+    <*> optional (strArgument (metavar "APP" <> help "Application config name or image:name or nix:expr"))+    <*> many (strArgument (metavar "ARGS" <> help "Application args"))++-- | List of strOption that accept an argument (that is not the selector)+strOptions :: [String]+strOptions = ["--config", "--namespace", "--name", "--env", "--volume", "-v"]++-- | Parse all capabilities toggles+capsParser :: Parser [Capabilities -> Capabilities]+capsParser = catMaybes <$> traverse mkCapParser Podenv.Application.capsAll+  where+    mkCapParser :: Podenv.Application.Cap -> Parser (Maybe (Capabilities -> Capabilities))+    mkCapParser cap =+      toggleCapParser cap True <|> toggleCapParser cap False++-- | A helper function to parse CLI capability toggle+toggleCapParser :: Podenv.Application.Cap -> Bool -> Parser (Maybe (Capabilities -> Capabilities))+toggleCapParser Podenv.Application.Cap {..} isOn = setMaybeCap <$> flagParser+  where+    -- We parse a dummy flag from the command line+    flagParser :: Parser (Maybe ())+    flagParser = optional (flag' () (long flagName <> hidden))+    flagName = toString $ (if isOn then "" else "no-") <> capName++    -- That will be replaced by the setCap when Just ()+    setMaybeCap :: Maybe () -> Maybe (Capabilities -> Capabilities)+    setMaybeCap = fmap (const setCap)+    setCap :: Capabilities -> Capabilities+    setCap = capLens .~ isOn++cliInfo :: ParserInfo CLI+cliInfo =+  info+    (versionOption <*> cliParser <**> helper)+    (fullDesc <> header "podenv - a container wrapper")+  where+    versionOption =+      infoOption+        (concat [showVersion version, " ", Podenv.Version.version])+        (long "version" <> help "Show version")++-- | Load the config+cliConfigLoad :: CLI -> IO (Application, Podenv.Application.Mode, Name, RuntimeEnv)+cliConfigLoad cli@CLI {..} = do+  system <- Podenv.Config.loadSystem+  -- The volumes dir may be provided by the system config, otherwise default to ~/.local/share/podenv/volumes+  volumesDir <- case data_volumes_dir system of+    Just fp -> pure $ toString fp+    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+      name' = Name $ fromMaybe (app ^. appName) name+      re = RuntimeEnv {verbose, system, 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+  where+    modifiers = setShell . setEnvs . setVolumes . setCaps . setNS . addArgs++    addArgs = appCommand %~ (<> args)++    setNS = maybe id (appNamespace ?~) namespace++    setShell = bool id setShellCap shell+    setShellCap = appCapabilities %~ (capTerminal .~ True) . (capInteractive .~ True)++    setEnvs app' = foldr (\v -> appEnviron %~ (v :)) app' cliEnv++    setVolumes app' = foldr (\v -> appVolumes %~ (v :)) app' volumes++    setCaps app' = foldr (appCapabilities %~) app' capsOverride++showApp :: Application -> Context -> Podenv.Build.BuildEnv -> RuntimeEnv -> Text+showApp Application {..} ctx be re = unlines infos+  where+    infos =+      ["[+] runtime: " <> Podenv.Build.beInfos be, ""]+        <> ["[+] Capabilities", unwords appCaps, ""]+        <> ["[+] Command", cmd]+    cmd = Podenv.Runtime.showRuntimeCmd re ctx+    appCaps = concatMap showCap Podenv.Application.capsAll+    showCap Podenv.Application.Cap {..} =+      [capName | capabilities ^. capLens]++printCaps :: IO ()+printCaps = do+  putText $ unlines $ sort $ map showCap Podenv.Application.capsAll+  where+    showCap Podenv.Application.Cap {..} =+      let sep = if Data.Text.length capName < 8 then "\t\t" else "\t"+       in capName <> sep <> capDescription++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) =+        "Application" <> maybe "" (\desc -> " (" <> desc <> ")") (app ^. appDescription)+      showFunc args app = "λ " <> args <> " → " <> showApp' app+      showArg a = "<" <> show a <> ">"+      showConfig = \case+        Podenv.Config.Lit app -> showApp' app+        Podenv.Config.LamArg name f -> showFunc (show name) (f (showArg name))+        Podenv.Config.LamArg2 n1 n2 f -> showFunc (show n1 <> " " <> show n2) (f (showArg n1) (showArg n2))+        Podenv.Config.LamApp _ -> "λ app → app"+      showAtom (name, app) = name <> ": " <> showConfig app+  traverse_ (putTextLn . showAtom) atoms
+ src/Podenv/Prelude.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Common functions+module Podenv.Prelude+  ( module Relude,+    foldM,+    lookup,+    getEnv,+    orDie,+    mayFail,++    -- * io+    readFileM,+    hPutStrLn,++    -- * base env++#if !MIN_VERSION_relude(1,0,0)+    getArgs,+    lookupEnv,+#endif+    getExecutablePath,++    -- * xdg+    getCacheDir,+    getConfigDir,+    getDataDir,++    -- * directory+    createDirectoryIfMissing,+    getCurrentDirectory,+    doesFileExist,+    doesPathExist,+    doesSymlinkExist,+    pathIsSymbolicLink,+    findExecutable,+    (</>),+    takeFileName,+    takeDirectory,+    hasTrailingPathSeparator,+    listDirectory,++    -- * posix+    UserID,+    getRealUserID,++    -- * lens+    Lens',+    (^.),+    (.~),+    (?~),+    (%~),+    setWhenNothing,+  )+where++import qualified Control.Exception+import Control.Monad (foldM)+import qualified Data.Text.IO+import Lens.Family (ASetter, set, (%~), (.~), (^.))+import Relude+import Relude.Extra.Lens (Lens')+import System.Directory+import System.Environment+import System.FilePath.Posix (hasTrailingPathSeparator, takeDirectory, takeFileName, (</>))+import System.IO (hPutStrLn)+import qualified System.Posix.Files+import System.Posix.Types (UserID)+import System.Posix.User (getRealUserID)++orDie :: Maybe a -> Text -> Either Text a+orDie (Just a) _ = Right a+orDie Nothing e = Left e++mayFail :: Either Text a -> IO a+mayFail (Right a) = pure a+mayFail (Left msg) = hPutStrLn stderr ("Error: " <> toString msg) >> exitFailure >> fail "over"++(?~) :: ASetter s t a (Maybe b) -> b -> s -> t+l ?~ b = set l (Just b)++setWhenNothing :: ASetter s t (Maybe b) (Maybe b) -> b -> s -> t+l `setWhenNothing` b = l %~ maybe (Just b) Just++getCacheDir :: IO FilePath+getCacheDir = getXdgDirectory XdgCache "podenv"++getDataDir :: IO FilePath+getDataDir = getXdgDirectory XdgData "podenv"++getConfigDir :: IO FilePath+getConfigDir = getXdgDirectory XdgConfig "podenv"++readFileM :: FilePath -> IO Text+readFileM fp' = do+  exist <- liftIO $ doesFileExist fp'+  if exist+    then liftIO $ Data.Text.IO.readFile fp'+    else pure ""++doesSymlinkExist :: FilePath -> IO Bool+doesSymlinkExist fp =+  either (const False) (const True) <$> checkFp+  where+    checkFp :: IO (Either Control.Exception.SomeException FilePath)+    checkFp = Control.Exception.try $ System.Posix.Files.readSymbolicLink fp
+ src/Podenv/Runtime.hs view
@@ -0,0 +1,299 @@+{-# LANGUAGE BlockArguments #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE NoImplicitPrelude #-}++-- | This module contains the podman/bubblewrap context wrapper+module Podenv.Runtime+  ( execute,+    showRuntimeCmd,++    -- * Podman helpers+    podman,+    podmanRunArgs,++    -- * Bubblewrap helpers+    bwrap,+    bwrapRunArgs,++    -- * data type and lenses+    module Podenv.Context,+    RuntimeEnv (..),+    defaultRuntimeEnv,+  )+where++import qualified Data.Map.Strict as Map+import qualified Data.Set+import qualified Data.Text as Text+import Podenv.Config (defaultSystemConfig)+import Podenv.Context+import Podenv.Dhall (SystemConfig (..), sysDns)+import Podenv.Prelude+import qualified System.Process.Typed as P++execute :: RuntimeEnv -> Context -> IO ()+execute re ctx = do+  traverse_ (ensureHostDirectory (volumesDir re)) (Map.elems $ ctx ^. mounts)+  runReaderT (doExecute ctx) re++-- | Create host directory and set SELinux label if needed+ensureHostDirectory :: FilePath -> Volume -> IO ()+ensureHostDirectory volumesDir (MkVolume _ (Volume volumeName)) =+  ensureHostDirectory' $ volumesDir </> toString volumeName+ensureHostDirectory _ (MkVolume _ (HostPath fp)) | (last <$> nonEmpty fp) == Just '/' = ensureHostDirectory' fp+ensureHostDirectory _ _ = pure ()++ensureHostDirectory' :: FilePath -> IO ()+ensureHostDirectory' fp = do+  exist <- doesPathExist fp+  unless exist $ do+    createDirectoryIfMissing True fp+    P.runProcess_ $ P.proc "chcon" ["system_u:object_r:container_file_t:s0", fp]++doExecute :: Context -> ContextEnvT ()+doExecute ctx = case ctx ^. runtimeCtx of+  Container image -> executePodman ctx image+  Bubblewrap fp -> executeBubblewrap ctx fp++executeBubblewrap :: Context -> FilePath -> ContextEnvT ()+executeBubblewrap ctx fp = do+  re <- ask+  let args = bwrapRunArgs re ctx fp+  let cmd = bwrap args+  debug $ show cmd+  P.runProcess_ cmd++bwrap :: [String] -> P.ProcessConfig () () ()+bwrap = P.setDelegateCtlc True . P.proc "bwrap"++commonArgs :: Context -> [Text]+commonArgs Context {..} =+  concatMap (\c -> ["--cap-add", Text.drop 4 (show c)]) _syscaps++bwrapRunArgs :: RuntimeEnv -> Context -> FilePath -> [String]+bwrapRunArgs RuntimeEnv {..} ctx@Context {..} fp = toString <$> args+  where+    userArg = case ctx ^. runAs of+      Just RunAsRoot -> ["--unshare-user", "--uid", "0"]+      Just RunAsHostUID -> []+      Just RunAsAnyUID -> ["--unshare-user", "--uid", show $ ctx ^. anyUid]+      Nothing -> []++    networkArg+      | _network = case _namespace of+        Just "host" -> []+        Just _ns -> error "Shared netns not implemented"+        Nothing -> [] -- TODO: implement private network namespace+      | otherwise = ["--unshare-net"]++    volumeArg :: (FilePath, Volume) -> [Text]+    volumeArg (destPath, MkVolume mode vtype) = case vtype of+      HostPath hostPath -> [volumeMode mode, toText hostPath, toText destPath]+      Volume x -> [volumeMode mode, toText $ volumesDir </> toString x, toText destPath]+      TmpFS -> ["--tmpfs", toText destPath]+      where+        volumeMode = \case+          RO -> "--ro-bind"+          RW -> "--bind"++    rootMounts = case fp of+      "/" ->+        doBind "usr"+          <> doBind "lib"+          <> doBind "lib64"+          <> doBind "bin"+          <> doBind "sbin"+          <> doBind "etc"+      c : _ | c `notElem` ['/', ':'] -> toText <$> [bindMode, toString volumesDir </> fp, "/"]+      _ -> doBind ""++    sysMounts+      | Data.Set.null _devices = []+      | otherwise = ["--ro-bind", "/sys", "/sys"]++    bindMode+      | ctx ^. ro = "--ro-bind"+      | otherwise = "--bind"+    doBind p = toText <$> [bindMode, fp </> p, "/" </> p]+    args =+      userArg+        <> ["--die-with-parent", "--unshare-pid", "--unshare-ipc", "--unshare-uts"]+        <> networkArg+        <> commonArgs ctx+        <> rootMounts+        <> ["--proc", "/proc"]+        <> ["--dev", "/dev"]+        <> ["--perms", "01777", "--tmpfs", "/tmp"]+        <> concatMap volumeArg (Map.toAscList _mounts)+        <> concatMap (\d -> ["--dev-bind", toText d, toText d]) _devices+        <> sysMounts+        <> ["--clearenv"]+        <> concatMap (\(k, v) -> ["--setenv", toText k, v]) (Map.toAscList _environ)+        <> cond (not _terminal) ["--new-session"]+        <> maybe [] (\wd -> ["--chdir", toText wd]) _workdir+        <> _command++showRuntimeCmd :: RuntimeEnv -> Context -> Text+showRuntimeCmd re ctx = case ctx ^. runtimeCtx of+  Container image -> show . P.proc "podman" $ podmanRunArgs re ctx image+  Bubblewrap fp -> show . P.proc "bwrap" $ bwrapRunArgs re ctx fp++data RuntimeEnv = RuntimeEnv+  { verbose :: Bool,+    system :: SystemConfig,+    volumesDir :: FilePath+  }+  deriving (Show)++defaultRuntimeEnv :: FilePath -> RuntimeEnv+defaultRuntimeEnv = RuntimeEnv True defaultSystemConfig++type ContextEnvT a = ReaderT RuntimeEnv IO a++debug :: Text -> ContextEnvT ()+debug msg = do+  isVerbose <- asks verbose+  when isVerbose $ liftIO $ hPutStrLn stderr ("[+] " <> toString msg)++cond :: Bool -> [a] -> [a]+cond b xs = if b then xs else []++infraName :: Text -> Text+infraName ns = ns <> "-ns"++podmanArgs :: Context -> [Text]+podmanArgs Context {..} = cond _interactive ["-i", "--detach-keys", ""] <> cond _terminal ["-t"]++podmanRunArgs :: RuntimeEnv -> Context -> ImageName -> [String]+podmanRunArgs RuntimeEnv {..} ctx@Context {..} image = toString <$> args+  where+    portArgs = concatMap publishArg _ports+    publishArg port = ["--publish", showPort port]+    showPort port = show $ case port of+      -- podman does not seem to distinguish protocol+      PortTcp p -> p+      PortUdp p -> p++    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+      | otherwise = ["--network", "none"]++    volumeArg :: (FilePath, Volume) -> [Text]+    volumeArg (fp, MkVolume mode vtype) = case vtype of+      HostPath x -> volume (toText x)+      Volume x -> volume (toText $ volumesDir </> toString x)+      TmpFS -> ["--mount", "type=tmpfs,destination=" <> toText fp]+      where+        volume hp = ["--volume", hp <> ":" <> toText fp <> showVolumeMode mode]+        showVolumeMode = \case+          RO -> ":ro"+          RW -> ""++    -- The goal here is to ensure host files created by the container are readable by the host user.+    userArg = case ctx ^. runAs of+      Just RunAsRoot -> ["--user", "0"]+      Just RunAsHostUID -> ["--user", show (ctx ^. uid), "--userns", "keep-id"]+      Just RunAsAnyUID ->+        let x = ctx ^. anyUid+         in ["--user", show x, "--uidmap", show x <> ":0:1", "--uidmap", "0:1:" <> show x]+      Nothing -> []++    nameArg = ["--name", unName _name]++    args =+      ["run"]+        <> podmanArgs ctx+        <> maybe [] (\h -> ["--hostname", h]) _hostname+        <> cond _privileged ["--privileged"]+        <> ["--rm"]+        <> cond _ro ["--read-only=true"]+        <> cond (not _selinux) ["--security-opt", "label=disable"]+        <> userArg+        <> networkArg+        <> commonArgs ctx+        <> concatMap (\d -> ["--device", toText d]) _devices+        <> maybe [] (\wd -> ["--workdir", toText wd]) _workdir+        <> concatMap (\(k, v) -> ["--env", toText $ k <> "=" <> v]) (Map.toAscList _environ)+        <> concatMap volumeArg (Map.toAscList _mounts)+        <> nameArg+        <> [unImageName image]+        <> _command++podman :: [String] -> P.ProcessConfig () () ()+podman = P.setDelegateCtlc True . P.proc "podman"++data PodmanStatus+  = -- | The container does not exists, it needs to be created+    NotFound+  | -- | The container is already running+    Running+  | -- | The container ran and it is now stopped+    Unknown Text+  deriving (Show, Eq)++getPodmanStatus :: String -> ContextEnvT PodmanStatus+getPodmanStatus cname = do+  (_, stdout', _) <- P.readProcess (podman ["inspect", cname, "--format", "{{.State.Status}}"])+  pure $ case stdout' of+    "" -> NotFound+    "running\n" -> Running+    other -> Unknown (Text.dropWhileEnd (== '\n') $ decodeUtf8 other)++ensureInfraNet :: Text -> ContextEnvT ()+ensureInfraNet ns = do+  debug $ "Ensuring infra net for: " <> show ns+  let pod = infraName ns+  infraStatus <- getPodmanStatus (toString pod)+  case infraStatus of+    Running -> pure ()+    _ -> do+      when (infraStatus /= NotFound) $+        -- Try to delete any left-over infra container+        P.runProcess_ (podman ["rm", toString pod])++      system' <- asks system+      let cmd =+            podman $+              map toString $+                ["run", "--rm", "--name", pod]+                  <> ["--detach"]+                  <> maybe [] (\dns -> ["--dns=" <> dns]) (system' ^. sysDns)+                  <> ["ubi8"]+                  <> ["sleep", "infinity"]+      debug $ show cmd+      P.runProcess_ cmd++executePodman :: Context -> ImageName -> ContextEnvT ()+executePodman ctx image = do+  re <- ask+  case (ctx ^. namespace, ctx ^. network) of+    (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+  args <-+    case status of+      NotFound -> pure $ podmanRunArgs re ctx image+      Running -> cfail "container is already running, use `exec` to join, or `--name new` to start a new instance"+      Unknown _ -> recreateContainer re+  let cmd = podman args+  debug $ show cmd+  P.runProcess_ cmd+  where+    cname = toString (unName $ ctx ^. name)+    -- Delete a non-kept container and return the run args+    recreateContainer re = do+      P.runProcess_ (podman ["rm", cname])+      pure $ podmanRunArgs re ctx image
+ src/Podenv/Version.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE TemplateHaskell #-}++-- | Podenv version+module Podenv.Version (version) where++import Development.GitRev (gitDirty, gitHash)+import Language.Haskell.TH.Env (envQ)++version :: String+version = case fromEnv of+  Just v -> v+  Nothing -> $(gitHash) <> dirty+  where+    fromEnv :: Maybe String+    fromEnv = $$(envQ "PODENV_COMMIT")+    dirty+      | $(gitDirty) = "-dirty"+      | otherwise = ""
+ test/Spec.hs view
@@ -0,0 +1,218 @@+{-# 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 Podenv.Env+import qualified Podenv.Main+import Podenv.Prelude (mayFail)+import qualified Podenv.Runtime+import System.Environment (getEnv, setEnv)+import Test.Hspec++main :: IO ()+main = mockEnv >> loadConfig >>= hspec . spec+  where+    loadConfig = Podenv.Config.load Nothing (Just "./test/config.dhall")++    -- Fix env values while keeping the host cache for dhall+    mockEnv = do+      curHome <- getEnv "HOME"+      setEnv "XDG_CACHE_HOME" (curHome <> "/.cache")+      setEnv "HOME" "/home/user"+      setEnv "WAYLAND_DISPLAY" "wayland-0"++spec :: Podenv.Config.Config -> Spec+spec config = describe "unit tests" $ do+  describe "config" $ do+    it "load simple" $ loadTest "env" []+    it "load collection" $ loadTest "{ a = env, b = env}" ["a", "b"]+    it "load nested" $ loadTest "{ a = { b = env, c = env}, d = env}" ["a.b", "a.c", "d"]+    it "load weak" $ loadTest "{ image = { runtime.image = \"ubi\" }, nix = { runtime.nix = \"n\" } }" ["image", "nix"]+  describe "builder config" $ do+    it "load firefox" $ do+      (_, baseApp) <- mayFail $ Podenv.Config.select config ["firefox"]+      (be, _) <- Podenv.Build.prepare defRe baseApp+      Text.take 34 (Podenv.Build.beInfos be) `shouldBe` "# Containerfile localhost/3c922bca"+    it "load nixify" $ do+      (_, baseApp) <- mayFail $ Podenv.Config.select config ["nixify", "firefox", "about:blank"]+      (be, _) <- Podenv.Build.prepare defRe baseApp+      Text.take 34 (Podenv.Build.beInfos be) `shouldBe` "# Containerfile localhost/3c922bca"+    it "override nixpkgs when necessary" $ do+      let mkApp installables pin =+            Podenv.Config.defaultApp+              { Podenv.Dhall.runtime = Podenv.Dhall.Nix (Podenv.Dhall.Flakes installables pin)+              }++      (_, app0) <- Podenv.Build.prepare defRe (mkApp ["nixpkgs#hello"] (Just "nixpkgs/42"))+      (Podenv.Dhall.command app0) `shouldContain` ["--override-input", "nixpkgs"]++      (_, app1) <- Podenv.Build.prepare defRe (mkApp ["nixpkgs/42#hello"] (Just "nixpkgs/42"))+      (Podenv.Dhall.command app1) `shouldNotContain` ["--override-input", "nixpkgs"]++      (_, app2) <- Podenv.Build.prepare defRe (mkApp ["nixpkgs/42#hello", "nixGL"] (Just "nixpkgs/42"))+      (Podenv.Dhall.command app2) `shouldContain` ["--override-input", "nixpkgs"]++  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"]+    it "handle separator" $ do+      cli <- Podenv.Main.usage ["--name", "test", "image:ubi8", "--", "ls", "-la"]+      Podenv.Main.extraArgs 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\"]}"+    it "add --arg" $ cliTest "env" ["--", "--arg"] "env // { command = [\"--arg\"]}"+    it "set cap" $ cliTest "env" ["--wayland"] (addCap "env" "wayland = True")+    it "unset cap" $ cliTest (addCap "env" "wayland = True") ["--no-wayland"] "env"+    it "set volume" $ cliTest "env" ["--volume", "/tmp/test"] "env // { volumes = [\"/tmp/test\"]}"+    it "one args" $ cliTest "\\(name : Text) -> env // { name }" ["a"] "env // { name = \"a\"}"+    it "two args" $ cliTest "\\(name : Text) -> \\(desc : Text) -> env // { name, description = Some desc }" ["a", "b"] "env // { name = \"a\", description = Some \"b\"}"+  describe "cli default" $ do+    it "image:name" $ cliTest "env" ["image:testy"] "def // { runtime = Podenv.Image \"testy\", name = \"image-b2effd\" }"+    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 "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 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" $+      podmanTest "env // { volumes = [\"~/src:/data\"]}" (defRun ["--security-opt", "label=disable", "--hostname", "env", "--volume", "/home/user/src:/data"])+    it "run many volumes" $+      podmanTest+        "env // { volumes = [\"/home/data:/tmp/data\", \"/tmp\", \"/home/old-data:/tmp/data\"]}"+        (defRun ["--security-opt", "label=disable", "--hostname", "env", "--volume", "/tmp:/tmp", "--volume", "/home/data:/tmp/data"])+  describe "podman cli" $ do+    it "run minimal" $ podmanCliTest ["image:ubi8"] ["run", "--rm", "--network", "none", "--name", "image-8bfbaa", "ubi8"]+    it "wayland disable selinux" $+      let cmd = ["run", "--rm", "--security-opt", "label=disable", "--network", "none", "--env", "GDK_BACKEND=wayland", "--env", "QT_QPA_PLATFORM=wayland", "--env", "WAYLAND_DISPLAY=wayland-0", "--env", "XDG_RUNTIME_DIR=/run/user/1000", "--env", "XDG_SESSION_TYPE=wayland", "--mount", "type=tmpfs,destination=/dev/shm", "--volume", "/etc/machine-id:/etc/machine-id", "--mount", "type=tmpfs,destination=/run/user", "--volume", "/run/user/1000/wayland-0:/run/user/1000/wayland-0", "--name", "image-8bfbaa", "ubi8"]+       in podmanCliTest ["--wayland", "image:ubi8"] cmd+    it "hostfile are substituted" $+      let cmd = ["run", "--rm", "--network", "none", "--volume", "/proc/cmdline:/data/cmdline", "--volume", "/etc/hosts:/data/hosts", "--name", "image-8bfbaa", "ubi8", "cat", "/data/hosts", "/data/cmdline"]+       in podmanCliTest ["--hostfile", "image:ubi8", "cat", "/etc/hosts", "/proc/cmdline"] cmd+    it "run with name" $+      podmanCliTest+        ["--name", "test", "image:ubi8"]+        ["run", "--rm", "--network", "none", "--name", "test", "ubi8"]+    it "run simple" $+      podmanCliTest+        ["--network", "--shell", "image:ubi8"]+        ["run", "-i", "--detach-keys", "", "-t", "--rm", "--hostname", "image-8bfbaa", "--env", "TERM=xterm-256color", "--name", "image-8bfbaa", "ubi8", "/bin/sh"]+    it "shell override hostfile" $ do+      let expected extra = ["run", "-i", "--detach-keys", "", "-t", "--rm", "--network", "none", "--env", "TERM=xterm-256color"] <> extra <> ["--name", "image-8bfbaa", "ubi8"]+          cmd = ["--hostfile", "--terminal", "image:ubi8", "vi", "/etc/hosts"]+      podmanCliTest+        (["--shell"] <> cmd)+        (expected [] <> ["/bin/sh"])+      podmanCliTest+        cmd+        (expected ["--volume", "/etc/hosts:/data/hosts"] <> ["vi", "/data/hosts"])+    it "run many volumes" $+      podmanCliTest+        ["--volume", "/home/data:/tmp/data", "--volume", "/tmp", "--volume", "/old:/tmp/data", "image:ubi8"]+        ["run", "--rm", "--security-opt", "label=disable", "--network", "none", "--volume", "/tmp:/tmp", "--volume", "/home/data:/tmp/data", "--name", "image-8bfbaa", "ubi8"]+    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+      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]+    defImg = "ubi8"+    defRe = Podenv.Runtime.defaultRuntimeEnv "/data"++    testEnv =+      AppEnv+        { _hostXdgRunDir = Just "/run/user/1000",+          _hostHomeDir = Just "/home/user",+          _hostCwd = "/usr/src/podenv",+          _hostUid = 1000,+          _appHomeDir = Just "/home/fedora",+          _rootfsHome = const $ pure $ Just "/home/nobody"+        }++    getFP ctx = case Podenv.Context._runtimeCtx ctx of+      Podenv.Context.Bubblewrap fp -> fp+      _ -> error "Not bwrap"++    defBwrap =+      ["--die-with-parent", "--unshare-pid", "--unshare-ipc", "--unshare-uts", "--unshare-net"]+        <> ["--ro-bind", "/srv", "/", "--proc", "/proc", "--dev", "/dev", "--perms", "01777", "--tmpfs", "/tmp"]+        <> ["--bind", "/home/user/.local/share/podenv/volumes/rootfs-53b3be-home", "/home/nobody"]+        <> ["--clearenv", "--setenv", "HOME", "/home/nobody", "--setenv", "TERM", "xterm-256color"]+        <> ["--chdir", "/home/nobody"]++    bwrapTest args expected = do+      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+      Podenv.Runtime.bwrapRunArgs re ctx (getFP ctx) `shouldBe` expected++    getImg ctx = case Podenv.Context._runtimeCtx ctx of+      Podenv.Context.Container image -> image+      _ -> error "Not podman"++    podmanCliTest args expected = do+      cli <- Podenv.Main.usage (["--rw"] <> args)+      (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+      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")+      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++      let got = Podenv.Main.cliPrepare cli args' baseApp+      got `shouldBe` expected++    loadTest code expected = do+      config' <- loadConfig Nothing code+      let got = case config' of+            Podenv.Config.ConfigApplication _ -> []+            Podenv.Config.ConfigApplications xs -> map fst xs+            _ -> error "Bad test config"+      got `shouldBe` expected++    addCap code capCode =+      "( " <> code <> " // { capabilities = (" <> code <> ").capabilities // {" <> capCode <> "}})"++    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+              ]+        )++    loadOne code = do+      config' <- loadConfig Nothing code+      case config' of+        Podenv.Config.ConfigApplication (Podenv.Config.Lit (Podenv.Config.ApplicationRecord x)) -> pure x+        _ -> error "Expected a single app"
+ test/config.dhall view
@@ -0,0 +1,12 @@+let Podenv = ../hub/Podenv.dhall++let fedora =+      \(pkgs : List Text) ->+        Podenv.Container+          Podenv.ContainerBuild::{ containerfile = "FROM fedora" }++in  { firefox.runtime = fedora [ "firefox" ]+    , nixify =+        \(app : Podenv.Application.Type) ->+          app // { volumes = [ "nix-store:/nix" ] }+    }