Update secret

Signed-off-by: magic_rb <magic_rb@redalder.org>

flake-secret.lock

@@ -2143,8 +2143,8 @@
     "secret": {
       "flake": false,
       "locked": {
-        "lastModified": 1703340642,
+        "lastModified": 1704823351,
-        "narHash": "sha256-x5bsZxdotUsK65SNukzUcAxdKX9maR4A8BhQ4p4AKgg=",
+        "narHash": "sha256-KAiEA1ftvLVzGEzgi6GwrTJ7vA54i76/a1EHPr/CoYU=",
         "path": "/home/main/dotfiles/secret",
         "type": "path"
       },

flake.lock

@@ -2143,7 +2143,7 @@
     "secret": {
       "flake": false,
       "locked": {
-        "lastModified": 1703949446,
+        "lastModified": 1704632399,
         "narHash": "sha256-pQpattmS9VmO3ZIQUFn66az8GSmB4IvYhTTCFn6SUmo=",
         "path": "/var/empty",
         "type": "path"

overlays/ifstate/module.nix

@@ -0,0 +1,53 @@
+{
+  pkgs,
+  lib,
+  config,
+  ...
+}: let
+  inherit
+    (lib)
+    mkEnableOption
+    mkOption
+    types
+    mkIf
+    getExe
+    ;
+  cfg = config.services.ifstate;
+  format = pkgs.formats.json {};
+in {
+  options.services.ifstate = {
+    enable =
+      mkEnableOption "Enable ifstate service";
+
+    package = mkOption {
+      type = types.package;
+      default = pkgs.ifstate;
+      description = ''
+      '';
+    };
+
+    settings = mkOption {
+      type = format.type;
+      default = {};
+      description = ''
+      '';
+    };
+  };
+
+  config = mkIf cfg.enable {
+    systemd.services.ifstate = {
+      description = "ifstate service";
+      wantedBy = ["network-online.target"];
+      after = ["network.target"];
+
+      restartIfChanged = true;
+
+      serviceConfig = {
+        Type = "oneshot";
+        ExecStart = "${getExe cfg.package} -c ${format.generate "ifstate.json" cfg.settings} apply";
+        ExecReload = "${getExe cfg.package} -c ${format.generate "ifstate.json" cfg.settings} apply";
+        RemainAfterExit = true;
+      };
+    };
+  };
+}

overlays/microvmp/.gitignore

@@ -0,0 +1,2 @@
+.stack-work/
+*~

overlays/microvmp/CHANGELOG.md

@@ -0,0 +1,11 @@
+# Changelog for `microvmp`
+
+All notable changes to this project will be documented in this file.
+
+The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
+and this project adheres to the
+[Haskell Package Versioning Policy](https://pvp.haskell.org/).
+
+## Unreleased
+
+## 0.1.0.0 - YYYY-MM-DD

overlays/microvmp/LICENSE

@@ -0,0 +1,30 @@
+Copyright Richard Brežák (c) 2024
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Richard Brežák nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

overlays/microvmp/README.md

@@ -0,0 +1 @@
+# microvmp

overlays/microvmp/Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

overlays/microvmp/app/Main.hs

@@ -0,0 +1,6 @@
+module Main (main) where
+
+import Lib
+
+main :: IO ()
+main = libMain

overlays/microvmp/default.nix

@@ -0,0 +1,7 @@
+{inputs, ...}: {
+  flake.overlays.microvmp = final: prev: {
+    microvmp =
+      final.python3.pkgs.callPackage ./microvmp.nix {
+      };
+  };
+}

overlays/microvmp/fourmolu.yaml

@@ -0,0 +1,51 @@
+# Number of spaces per indentation step
+indentation: 2
+
+# Max line length for automatic line breaking
+column-limit: none
+
+# Styling of arrows in type signatures (choices: trailing, leading, or leading-args)
+function-arrows: leading
+
+# How to place commas in multi-line lists, records, etc. (choices: leading or trailing)
+comma-style: leading
+
+# Styling of import/export lists (choices: leading, trailing, or diff-friendly)
+import-export-style: diff-friendly
+
+# Whether to full-indent or half-indent 'where' bindings past the preceding body
+indent-wheres: false
+
+# Whether to leave a space before an opening record brace
+record-brace-space: false
+
+# Number of spaces between top-level declarations
+newlines-between-decls: 1
+
+# How to print Haddock comments (choices: single-line, multi-line, or multi-line-compact)
+haddock-style: multi-line
+
+# How to print module docstring
+haddock-style-module: null
+
+# Styling of let blocks (choices: auto, inline, newline, or mixed)
+let-style: auto
+
+# How to align the 'in' keyword with respect to the 'let' keyword (choices: left-align, right-align, or no-space)
+in-style: right-align
+
+# Whether to put parentheses around a single constraint (choices: auto, always, or never)
+single-constraint-parens: always
+
+# Output Unicode syntax (choices: detect, always, or never)
+unicode: never
+
+# Give the programmer more choice on where to insert blank lines
+respectful: true
+
+# Fixity information for operators
+fixities: []
+
+# Module reexports Fourmolu should know about
+reexports: []
+

overlays/microvmp/hie.yaml

@@ -0,0 +1,10 @@
+cradle:
+  stack:
+    - path: "./src"
+      component: "microvmp:lib"
+
+    - path: "./app/Main.hs"
+      component: "microvmp:exe:microvmp-exe"
+
+    - path: "./test"
+      component: "microvmp:test:microvmp-test"

overlays/microvmp/microvmp.cabal

@@ -0,0 +1,98 @@
+cabal-version: 2.2
+
+-- This file has been generated from package.yaml by hpack version 0.36.0.
+--
+-- see: https://github.com/sol/hpack
+
+name:           microvmp
+version:        0.1.0.0
+description:    Please see the README on GitHub at <https://github.com/MagicRB/microvmp#readme>
+homepage:       https://github.com/MagicRB/microvmp#readme
+bug-reports:    https://github.com/MagicRB/microvmp/issues
+author:         Richard Brežák
+maintainer:     richard@brezak.sk
+copyright:       Richard Brežák 2023
+license:        BSD-3-Clause
+license-file:   LICENSE
+build-type:     Simple
+extra-source-files:
+    README.md
+    CHANGELOG.md
+
+source-repository head
+  type: git
+  location: https://github.com/MagicRB/microvmp
+
+library
+  exposed-modules:
+      Lib
+      SGR
+  other-modules:
+      Paths_microvmp
+  autogen-modules:
+      Paths_microvmp
+  hs-source-dirs:
+      src
+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
+  build-depends:
+      ansi-terminal
+    , base >=4.7 && <5
+    , bytestring
+    , colour
+    , effectful
+    , extra
+    , filepath
+    , optparse-applicative
+    , text
+    , typed-process-effectful
+    , unix
+  default-language: Haskell2010
+
+executable microvmp-exe
+  main-is: Main.hs
+  other-modules:
+      Paths_microvmp
+  autogen-modules:
+      Paths_microvmp
+  hs-source-dirs:
+      app
+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      ansi-terminal
+    , base >=4.7 && <5
+    , bytestring
+    , colour
+    , effectful
+    , extra
+    , filepath
+    , microvmp
+    , optparse-applicative
+    , text
+    , typed-process-effectful
+    , unix
+  default-language: Haskell2010
+
+test-suite microvmp-test
+  type: exitcode-stdio-1.0
+  main-is: Spec.hs
+  other-modules:
+      Paths_microvmp
+  autogen-modules:
+      Paths_microvmp
+  hs-source-dirs:
+      test
+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
+  build-depends:
+      ansi-terminal
+    , base >=4.7 && <5
+    , bytestring
+    , colour
+    , effectful
+    , extra
+    , filepath
+    , microvmp
+    , optparse-applicative
+    , text
+    , typed-process-effectful
+    , unix
+  default-language: Haskell2010

overlays/microvmp/microvmp.nix

@@ -0,0 +1,216 @@
+{
+  writeScriptBin,
+  runtimeShell,
+  lib,
+  git,
+  jq,
+  nix,
+}: let
+  colors = {
+    normal = "\\033[0m";
+    red = "\\033[0;31m";
+    green = "\\033[0;32m";
+    boldRed = "\\033[1;31m";
+    boldYellow = "\\033[1;33m";
+    boldGreen = "\\033[1;32m";
+    boldCyan = "\\033[1;36m";
+  };
+  colored = color: text: "${colors.${color}}${text}${colors.normal}";
+in
+  writeScriptBin "microvm" ''
+    #! ${runtimeShell}
+    set -e
+
+    PATH=${lib.makeBinPath [
+      git
+      jq
+      nix
+    ]}:$PATH
+    STATE_DIR=/var/lib/microvms
+    ACTION=help
+    FLAKE=
+    DECLARED_RUNNER=
+    RESTART=n
+
+    OPTERR=1
+    while getopts ":c:C:f:uRr:s:lp:" arg; do
+      case $arg in
+        c)
+          ACTION=create
+          NAME=$OPTARG
+          ;;
+
+        u)
+          ACTION=update
+          NAME=$OPTARG
+          ;;
+
+        r)
+          ACTION=run
+          NAME=$OPTARG
+          ;;
+
+        l)
+          ACTION=list
+          ;;
+
+        f)
+          FLAKE=$OPTARG
+          ;;
+
+        p)
+          DECLARED_RUNNER=$OPTARG
+          ;;
+
+        R)
+          RESTART=y
+          ;;
+
+        ?)
+          ACTION=help
+          ;;
+      esac
+    done
+    # consume all $@ that were processed by getopts
+    shift $((OPTIND -1))
+    DIR=$STATE_DIR/$NAME
+
+    build() {
+      NAME=$1
+
+      if [ -e toplevel ]; then
+        echo -e "${colored "red" "This MicroVM is managed fully declaratively and cannot be updated manually!"}"
+        return 1
+      fi
+
+      FLAKE=$(cat flake)
+
+      nix build -o current "$FLAKE"#nixosConfigurations."$NAME".config.microvm.declaredRunner >/dev/null
+      chmod -R u+rwX .
+    }
+
+    case $ACTION in
+      help)
+        echo Help:
+        cat << EOF
+    Usage: $0 <action> [flags]
+
+    Actions:
+            -c <name>   Create a MicroVM
+            -u <names>  Rebuild (update) MicroVMs
+            -r <name>   Run a MicroVM in foreground
+            -l          List MicroVMs
+
+    Flags:
+            -f <flake>  Create using another flake than $FLAKE
+            -p <runner> Create using declared runner instead of flake
+            -R          Restart after update
+    EOF
+        ;;
+      create)
+        TEMP=$(mktemp -d)
+        pushd "$TEMP" > /dev/null
+        echo -n "$FLAKE" > flake
+        if ! [ -z "$DECLARED_RUNNER" ] && [ -z "$FLAKE" ] ; then
+          ln -s "$DECLARED_RUNNER" current
+        elif [ -z "$DECLARED_RUNNER" ] &&  ! [ -z "$FLAKE" ] ; then
+          build "$NAME"
+        else
+          echo -e "${colored "red" "Cannot specify both flake and declared runner"}"
+          exit 1
+       fi
+
+        popd > /dev/null
+        if [ -e "$DIR" ]; then
+          echo "$DIR already exists."
+          exit 1
+        fi
+        mv "$TEMP" "$DIR"
+        chown :kvm -R "$DIR"
+        chmod -R a+rX "$DIR"
+        chmod g+w "$DIR"
+
+        mkdir -p /nix/var/nix/gcroots/microvm
+        ln -sf "$DIR/current" "/nix/var/nix/gcroots/microvm/$NAME"
+        ln -sf "$DIR/booted" "/nix/var/nix/gcroots/microvm/booted-$NAME"
+
+        echo -e "${colored "green" "Created MicroVM $NAME."} Start with: ${colored "boldCyan" "systemctl start microvm@$NAME.service"}"
+        ;;
+
+      update)
+        for NAME in "$@" ; do
+          DIR="$STATE_DIR/$NAME"
+          pushd "$DIR" > /dev/null
+          OLD=""
+          [ -L current ] && OLD=$(readlink current)
+          build "$NAME"
+
+          BUILT=$(readlink current)
+          [ -n "$OLD" ] && nix store diff-closures "$OLD" "$BUILT"
+
+          if [ -L booted ]; then
+            BOOTED=$(readlink booted)
+            if [ "$BUILT" = "$BOOTED" ]; then
+              echo "No reboot of MicroVM $NAME required."
+            else
+              if [ $RESTART = y ]; then
+                echo "Rebooting MicroVM $NAME"
+                systemctl restart "microvm@$NAME.service"
+              else
+                echo "Reboot MicroVM $NAME for the new profile: systemctl restart microvm@$NAME.service"
+              fi
+            fi
+          elif [ "$RESTART" = y ]; then
+            echo "Booting MicroVM $NAME"
+            systemctl restart "microvm@$NAME.service"
+          fi
+        done
+        ;;
+
+      run)
+        cd "$DIR"
+        exec ./current/bin/microvm-run
+        ;;
+
+      list)
+        for DIR in "$STATE_DIR"/* ; do
+          NAME=$(basename "$DIR")
+          if [ -d "$DIR" ] && [ -L "$DIR/current" ] ; then
+            CURRENT_SYSTEM=$(readlink "$DIR/current/share/microvm/system")
+            CURRENT=''${CURRENT_SYSTEM#*-}
+
+            if [ -e "$DIR/toplevel" ]; then
+              # Should always equal current system
+              NEW_SYSTEM=$(readlink "$DIR/toplevel")
+            else
+              FLAKE=$(cat "$DIR/flake")
+              NEW_SYSTEM=$(nix --option narinfo-cache-negative-ttl 10 eval --raw "$FLAKE#nixosConfigurations.$NAME.config.system.build.toplevel")
+            fi
+            NEW=''${NEW_SYSTEM#*-}
+
+            if systemctl is-active -q "microvm@$NAME" ; then
+              echo -n -e "${colors.boldGreen}"
+            elif [ -e "$DIR/booted" ]; then
+              echo -n -e "${colors.boldYellow}"
+            else
+              echo -n -e "${colors.boldRed}"
+            fi
+            echo -n -e "''${NAME}${colors.normal}: "
+            if [ "$CURRENT_SYSTEM" != "$NEW_SYSTEM" ] ; then
+              echo -e "${colored "red" "outdated"}(${colored "red" "$CURRENT"}), rebuild(${colored "green" "$NEW"}) and reboot: ${colored "boldCyan" "microvm -Ru $NAME"}"
+            elif [ -L "$DIR/booted" ]; then
+              BOOTED_SYSTEM=$(readlink "$DIR/booted/share/microvm/system")
+              BOOTED=''${BOOTED_SYSTEM#*-}
+              if [ "$NEW_SYSTEM" = "$BOOTED_SYSTEM" ]; then
+                echo -e "${colored "green" "current"}(${colored "green" "$BOOTED"})"
+              else
+                echo -e "${colored "red" "stale"}(${colored "green" "$BOOTED"}), reboot(${colored "green" "$NEW"}): ${colored "boldCyan" "systemctl restart microvm@$NAME.service"}"
+              fi
+            else
+              echo -e "${colored "green" "current"}(${colored "green" "$CURRENT"}), not booted: ${colored "boldCyan" "systemctl start microvm@$NAME.service"}"
+            fi
+          fi
+        done
+        ;;
+    esac
+  ''

overlays/microvmp/package.yaml

@@ -0,0 +1,69 @@
+name:                microvmp
+version:             0.1.0.0
+github:              "MagicRB/microvmp"
+license:             BSD-3-Clause
+author:              "Richard Brežák"
+maintainer:          "richard@brezak.sk"
+copyright:           " Richard Brežák 2023"
+
+extra-source-files:
+- README.md
+- CHANGELOG.md
+
+# Metadata used when publishing your package
+# synopsis:            Short description of your package
+# category:            Virtual Machines
+
+# To avoid duplicated efforts in documentation and dealing with the
+# complications of embedding Haddock markup inside cabal files, it is
+# common to point users to the README.md file.
+description:         Please see the README on GitHub at <https://github.com/MagicRB/microvmp#readme>
+
+dependencies:
+- base >= 4.7 && < 5
+- optparse-applicative
+- effectful
+- typed-process-effectful
+- text
+- bytestring
+- filepath
+- extra
+- unix
+- ansi-terminal
+- colour
+
+ghc-options:
+- -Wall
+- -Wcompat
+- -Widentities
+- -Wincomplete-record-updates
+- -Wincomplete-uni-patterns
+- -Wmissing-export-lists
+- -Wmissing-home-modules
+- -Wpartial-fields
+- -Wredundant-constraints
+
+library:
+  source-dirs: src
+
+executables:
+  microvmp-exe:
+    main:                Main.hs
+    source-dirs:         app
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    dependencies:
+    - microvmp
+
+tests:
+  microvmp-test:
+    main:                Spec.hs
+    source-dirs:         test
+    ghc-options:
+    - -threaded
+    - -rtsopts
+    - -with-rtsopts=-N
+    dependencies:
+    - microvmp

overlays/microvmp/src/Lib.hs

@@ -0,0 +1,238 @@
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE MultiWayIf #-}
+module Lib
+    ( someFunc
+    , libMain
+    ) where
+
+import Options.Applicative
+import Data.Text (Text)
+import Effectful
+import Effectful.Process.Typed
+import Data.Function
+import qualified Data.Text.Encoding as T
+import Data.Functor
+import qualified Data.ByteString as BS
+import qualified Data.Text as T
+import Effectful.FileSystem
+import Effectful.FileSystem.IO.File
+import Control.Monad.Extra
+import System.FilePath
+import Effectful.FileSystem.IO hiding (withBinaryFile)
+import System.Console.ANSI hiding (setSGR, SGR(..))
+import SGR
+
+
+stateDir :: FilePath
+stateDir = "/var/lib/microvms"
+
+data MicroVmSource
+  = Flake Text
+  | DeclaredRunner Text
+  deriving (Show)
+
+data Options =
+  Create { name :: Text, source :: MicroVmSource }
+  | Update { names :: [Text], restart :: Bool }
+  | Run { name :: Text }
+  | List {}
+  deriving (Show)
+
+someFunc :: IO ()
+someFunc = putStrLn "someFunc"
+
+flakeSourceParser :: Parser MicroVmSource
+flakeSourceParser = Flake <$> strOption (long "flake" <> short 'f' <> metavar "FLAKE" <> help "create using a flake")
+
+declaredRunnerSourceParser :: Parser MicroVmSource
+declaredRunnerSourceParser = Flake <$> strOption (long "declared-runner" <> short 'd' <> metavar "DECLARED_RUNNER" <> help "create using a declared runner")
+
+createParser :: Parser Options
+createParser = Create
+  <$> strOption (long "create" <> short 'c' <> metavar "NAME" <> help "create a microvm")
+  <*> (flakeSourceParser <|> declaredRunnerSourceParser)
+
+updateParser :: Parser Options
+updateParser = Update
+  <$> many (strOption (long "update" <> short 'u' <> metavar "NAMES" <> help "update microvms"))
+  <*> switch (long "restart" <> short 'R' <> help "restart after update")
+
+runParser :: Parser Options
+runParser = Run <$> strOption (long "run" <> short 'r' <> metavar "NAME" <> help "run a microvm")
+
+listParser :: Parser Options
+listParser = List <$ flag' () (long "list" <> short 'l' <> help "list available microvms")
+
+optionParser :: Parser Options
+optionParser = createParser <|> updateParser <|> runParser <|> listParser
+
+withTemporaryDirectory :: (TypedProcess :> es) => (FilePath -> Eff es a) -> Eff es a
+withTemporaryDirectory action = do
+  let pConf = proc "mktemp" ["-d"] & setStdout byteStringOutput
+  stdout <- readProcessStdout_ pConf <&> (<&> T.takeWhile (/= '\n')) . T.decodeUtf8' . BS.toStrict
+  case stdout of
+    Right tempDir -> action (T.unpack tempDir)
+    Left _ -> undefined
+
+readFlake :: (FileSystem :> es, IOE :> es) => FilePath -> Eff es Text
+readFlake dir = withBinaryFile (dir </> "flake") ReadMode (liftIO . BS.hGetContents)
+  <&> either (\err -> error ("Couldn't read flake ref of a imperative microvm: " <> show err)) id . T.decodeUtf8'
+
+
+build :: (TypedProcess :> es, FileSystem :> es, IOE :> es) => FilePath -> Text -> Eff es ()
+build dir name = do
+  whenM (doesFileExist (dir </> "toplevel")) (error "This MicroVM is managed fully declaratively and cannot be updated manually!")
+
+  flake <- readFlake dir
+
+  let pConf =
+        proc "nix" ["build", "-o", dir </> "current", T.unpack flake <> "#nixosConfigurations." <> T.unpack name <> ".config.microvm.declaredRunner"]
+  whenM (runProcess pConf <&> (/= ExitSuccess)) (error "nix build failed")
+  whenM (runProcess (proc "chmod" ["-R", "u+rwX", dir]) <&> (/= ExitSuccess)) (error "chmod failed")
+
+
+effMain :: (IOE :> es) => Options -> Eff es ()
+effMain Create { name, source } = runTypedProcess . runFileSystem $ withTemporaryDirectory \tmpDir -> do
+  createDirectory tmpDir
+
+  case source of
+    Flake flakeref -> do
+      writeBinaryFile (tmpDir </> "flake") (T.encodeUtf8 flakeref)
+      build tmpDir name
+    DeclaredRunner runner -> do
+      let runnerS = T.unpack runner
+      doesDirectoryExist runnerS >>= \case
+        True -> (createFileLink runnerS (tmpDir </> "current"))
+        False -> error ("declared runner " <> runnerS <> " does not exist")
+
+  let dir = stateDir </> T.unpack name
+  whenM (doesPathExist dir) (error (dir <> " already exists"))
+
+  whenM (runProcess (proc "chown" [":kvm", "-R", dir]) <&> (/= ExitSuccess)) (error "chown failed")
+  whenM (runProcess (proc "chmod" ["-R", "a+rX", dir]) <&> (/= ExitSuccess)) (error "chmod failed")
+  whenM (runProcess (proc "chmod" ["g+w", dir]) <&> (/= ExitSuccess)) (error "chmod failed")
+
+  whenM (doesDirectoryExist "/nix/var/nix/gcroots/microvm" <&> not) $ createDirectory "/nix/var/nix/gcroots/microvm"
+  createFileLink (dir </> "current") ("/nix/var/nix/gcroots/microvm" </> T.unpack name)
+  createFileLink (dir </> "booted") ("/nix/var/nix/gcroots/microvm" </> ("booted-" <> T.unpack name))
+
+  liftIO . print @Text $ "Created MicroVM $NAME." <> "Start with: " <> "systemctl start microvm@$NAME.service"
+
+effMain Update { names, restart } = runTypedProcess . runFileSystem $ pure ()
+effMain Run { name } = runTypedProcess . runFileSystem $ do
+  _ <- runProcess pConf
+  pure ()
+  where
+    pConf = proc (stateDir </> T.unpack name </> "current/bin/microvm-run") []
+                 & setStdin inherit
+                 & setStdout inherit
+                 & setStderr inherit
+
+effMain List {} = runTypedProcess . runFileSystem $ do
+  names <- listDirectory stateDir >>= filterM (\name -> doesDirectoryExist (stateDir </> name) &&^ pathIsSymbolicLink (stateDir </> name </> "current"))
+  forM_ names \name -> do
+    let dir = stateDir </> name
+    currentSystem <- getSymbolicLinkTarget (dir </> "current/share/microvm/system")
+    let current = takeWhile (/= '-') currentSystem
+
+    newSystem <- doesPathExist (dir </> "toplevel") >>= \bool -> if bool then
+        getSymbolicLinkTarget (dir </> "toplevel")
+      else do
+        flake <- readFlake dir
+        let pConf = proc "nix" ["--option", "narinfo-cache-negative-ttl", "10", "eval", "--raw", T.unpack flake <> "#nixosConfigurations." <> name <> ".config.system.build.toplevel"]
+               & setStdout byteStringOutput
+        readProcessStdout_ pConf <&> either (\err -> error "") T.unpack . (<&> T.takeWhile (/= '\n')) . T.decodeUtf8' . BS.toStrict
+    let new = takeWhile (/= '-') newSystem
+
+    runProcess (proc "systemctl" ["is-active", "-q", "microvm@" <> name]) >>= \exitCode -> if exitCode == ExitSuccess then
+      liftIO $ setSGR [SetColor Foreground Vivid Green]
+    else doesPathExist (dir </> "booted") >>= \exists -> if exists then
+      liftIO $ setSGR [SetColor Foreground Vivid Yellow]
+    else
+      liftIO $ setSGR [SetColor Foreground Vivid Red]
+    liftIO $ putStr name
+    liftIO $ setSGR []
+    liftIO $ putStr ": "
+
+    bootedIsLink <- doesPathExist (dir </> "booted") &&^ pathIsSymbolicLink (dir </> "booted")
+    if
+      | currentSystem /= newSystem -> liftIO do
+        setSGR
+          [ SetColor Foreground Dull Red, "outdated"
+          , Reset
+          , "(", SetColor Foreground Dull Red, Text $ T.pack current
+          , Reset
+          , "), rebuild("
+          , SetColor Foreground Dull Green
+          , Text $ T.pack new
+          , Reset
+          , ") and reboot: "
+          , SetColor Foreground Vivid Cyan
+          , Text ("microvm -Ru " <> T.pack name)
+          ]
+      | bootedIsLink -> do
+        bootedSystem <- getSymbolicLinkTarget (dir </> "booted")
+        let booted = takeWhile (/= '-') bootedSystem
+
+        if newSystem == bootedSystem then liftIO do
+          setSGR
+            [ SetColor Foreground Dull Green
+            , "current"
+            , Reset
+            , "("
+            , SetColor Foreground Dull Green
+            , Text $ T.pack booted
+            , Reset
+            , ")"
+            ]
+        else liftIO do
+          setSGR
+            [ SetColor Foreground Dull Red
+            , "stale"
+            , Reset
+            , "("
+            , SetColor Foreground Dull Green
+            , Text $ T.pack booted
+            , Reset
+            , "), reboot("
+            , SetColor Foreground Dull Green
+            , Text $ T.pack new
+            , Reset
+            , "): "
+            , SetColor Foreground Vivid Cyan
+            , "systemctl restart micvovm@"
+            , Text $ T.pack name
+            , ".service"
+            ]
+      | otherwise -> liftIO do
+        setSGR
+          [ SetColor Foreground Dull Green
+          , Text $ T.pack current
+          , Reset
+          , "("
+          , SetColor Foreground Dull Green
+          , Text $ T.pack current
+          , Reset
+          , "), not booted: "
+          , SetColor Foreground Vivid Cyan
+          , "systemctl start microvm@"
+          , Text $ T.pack name
+          , ".service"
+          ]
+    liftIO $ setSGR ["\n"]
+
+libMain :: IO ()
+libMain = do
+  let opts = info (optionParser <**> helper)
+        ( fullDesc
+          <> progDesc "Print a greeting for TARGET"
+          <> header "hello - a test for optparse-applicative" )
+  options <- execParser opts
+  print options
+  runEff $ effMain options

overlays/microvmp/src/SGR.hs

@@ -0,0 +1,59 @@
+module SGR (SGR(..), setSGR) where
+
+import Data.Word (Word8)
+import qualified System.Console.ANSI as ANSI
+import qualified Data.Colour.SRGB as SRGB
+import qualified Data.Text as T
+import Data.Function
+import Data.List
+import Data.Either
+import Data.String
+
+data SGR
+  = Reset
+  | Text T.Text
+  | SetConsoleIntensity !ANSI.ConsoleIntensity
+  | SetItalicized !Bool
+  | SetUnderlining !ANSI.Underlining
+  | SetBlinkSpeed !ANSI.BlinkSpeed
+  | SetVisible !Bool
+  | SetSwapForegroundBackground !Bool
+  | SetColor !ANSI.ConsoleLayer !ANSI.ColorIntensity !ANSI.Color
+  | SetRGBColor !ANSI.ConsoleLayer !(SRGB.Colour Float)
+  | SetPaletteColor !ANSI.ConsoleLayer !Word8
+  | SetDefaultColor !ANSI.ConsoleLayer
+  deriving (Eq, Read, Show)
+
+instance IsString SGR where
+  fromString string = Text $ T.pack string
+
+toTextSGR :: SGR -> Either ANSI.SGR T.Text
+toTextSGR Reset = Left ANSI.Reset
+toTextSGR (Text text) = Right text
+toTextSGR (SetConsoleIntensity consoleIntensity) = Left $ ANSI.SetConsoleIntensity consoleIntensity
+toTextSGR (SetItalicized italicized) = Left $ ANSI.SetItalicized italicized
+toTextSGR (SetUnderlining underlining) = Left $ ANSI.SetUnderlining underlining
+toTextSGR (SetBlinkSpeed blinkSpeed) = Left $ ANSI.SetBlinkSpeed blinkSpeed
+toTextSGR (SetVisible visible) = Left $ ANSI.SetVisible visible
+toTextSGR (SetSwapForegroundBackground swapForegroundBackground) = Left $ ANSI.SetSwapForegroundBackground swapForegroundBackground
+toTextSGR (SetColor consoleLayer colorIntensity color) = Left $ ANSI.SetColor consoleLayer colorIntensity color
+toTextSGR (SetRGBColor consoleLayer color) = Left $ ANSI.SetRGBColor consoleLayer color
+toTextSGR (SetPaletteColor consoleLayer index) = Left $ ANSI.SetPaletteColor consoleLayer index
+toTextSGR (SetDefaultColor consoleLayer) = Left $ ANSI.SetDefaultColor consoleLayer
+
+leftRightEqual :: Either a b -> Either a b -> Bool
+leftRightEqual (Left _) (Left _) = True
+leftRightEqual (Right _) (Right _) = True
+leftRightEqual _ _ = False
+
+joinEithers :: [Either a b] -> Either [a] [b]
+joinEithers (Left a:xs) = Left $ lefts (Left a : xs)
+joinEithers (Right b:xs) = Right $ rights (Right b : xs)
+joinEithers [] = Left []
+
+executeEither :: Either [ANSI.SGR] [T.Text] -> IO ()
+executeEither (Left sgrs) = ANSI.setSGR sgrs
+executeEither (Right texts) = mapM_ (putStr . T.unpack) texts
+
+setSGR :: [SGR] -> IO ()
+setSGR sgrs = mapM_ (executeEither . joinEithers) . groupBy leftRightEqual $ map toTextSGR sgrs

overlays/microvmp/stack.yaml

@@ -0,0 +1,67 @@
+# This file was automatically generated by 'stack init'
+#
+# Some commonly used options have been documented as comments in this file.
+# For advanced use and comprehensive documentation of the format, please see:
+# https://docs.haskellstack.org/en/stable/yaml_configuration/
+
+# Resolver to choose a 'specific' stackage snapshot or a compiler version.
+# A snapshot resolver dictates the compiler version and the set of packages
+# to be used for project dependencies. For example:
+#
+# resolver: lts-21.13
+# resolver: nightly-2023-09-24
+# resolver: ghc-9.6.2
+#
+# The location of a snapshot can be provided as a file or url. Stack assumes
+# a snapshot provided as a file might change, whereas a url resource does not.
+#
+# resolver: ./custom-snapshot.yaml
+# resolver: https://example.com/snapshots/2023-01-01.yaml
+resolver: lts-21.11
+
+# User packages to be built.
+# Various formats can be used as shown in the example below.
+#
+# packages:
+# - some-directory
+# - https://example.com/foo/bar/baz-0.0.2.tar.gz
+#   subdirs:
+#   - auto-update
+#   - wai
+packages:
+- .
+# Dependency packages to be pulled from upstream that are not in the resolver.
+# These entries can reference officially published versions as well as
+# forks / in-progress versions pinned to a git hash. For example:
+#
+# extra-deps:
+# - acme-missiles-0.3
+# - git: https://github.com/commercialhaskell/stack.git
+#   commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
+#
+extra-deps:
+- typed-process-effectful-1.0.0.1@sha256:a49b9b4ffb2bb1be80ad6462322ea5bb4b3819a8ba3eac2a6ca58bd0da21c92e,2078
+
+# Override default flag values for local packages and extra-deps
+# flags: {}
+
+# Extra package databases containing global packages
+# extra-package-dbs: []
+
+# Control whether we use the GHC we find on the path
+# system-ghc: true
+#
+# Require a specific version of Stack, using version ranges
+# require-stack-version: -any # Default
+# require-stack-version: ">=2.13"
+#
+# Override the architecture used by Stack, especially useful on Windows
+# arch: i386
+# arch: x86_64
+#
+# Extra directories used by Stack for building
+# extra-include-dirs: [/path/to/dir]
+# extra-lib-dirs: [/path/to/dir]
+#
+# Allow a newer minor version of GHC than the snapshot specifies
+# compiler-check: newer-minor

overlays/microvmp/stack.yaml.lock

@@ -0,0 +1,19 @@
+# This file was autogenerated by Stack.
+# You should not edit this file by hand.
+# For more information, please see the documentation at:
+#   https://docs.haskellstack.org/en/stable/lock_files
+
+packages:
+- completed:
+    hackage: typed-process-effectful-1.0.0.1@sha256:a49b9b4ffb2bb1be80ad6462322ea5bb4b3819a8ba3eac2a6ca58bd0da21c92e,2078
+    pantry-tree:
+      sha256: 050366c05009fc7eca36428bab3bd58f3a065eb5767e50652480b7fbb775b871
+      size: 404
+  original:
+    hackage: typed-process-effectful-1.0.0.1@sha256:a49b9b4ffb2bb1be80ad6462322ea5bb4b3819a8ba3eac2a6ca58bd0da21c92e,2078
+snapshots:
+- completed:
+    sha256: 64d66303f927e87ffe6b8ccf736229bf608731e80d7afdf62bdd63c59f857740
+    size: 640037
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/21/11.yaml
+  original: lts-21.11

overlays/microvmp/test/Spec.hs

@@ -0,0 +1,2 @@
+main :: IO ()
+main = putStrLn "Test suite not yet implemented"