diff --git a/flake-secret.lock b/flake-secret.lock index 6b92b7d..94e3b72 100644 --- a/flake-secret.lock +++ b/flake-secret.lock @@ -2143,8 +2143,8 @@ "secret": { "flake": false, "locked": { - "lastModified": 1703340642, - "narHash": "sha256-x5bsZxdotUsK65SNukzUcAxdKX9maR4A8BhQ4p4AKgg=", + "lastModified": 1704823351, + "narHash": "sha256-KAiEA1ftvLVzGEzgi6GwrTJ7vA54i76/a1EHPr/CoYU=", "path": "/home/main/dotfiles/secret", "type": "path" }, diff --git a/flake.lock b/flake.lock index a5b706e..8fcf384 100644 --- a/flake.lock +++ b/flake.lock @@ -2143,7 +2143,7 @@ "secret": { "flake": false, "locked": { - "lastModified": 1703949446, + "lastModified": 1704632399, "narHash": "sha256-pQpattmS9VmO3ZIQUFn66az8GSmB4IvYhTTCFn6SUmo=", "path": "/var/empty", "type": "path" diff --git a/overlays/ifstate/module.nix b/overlays/ifstate/module.nix new file mode 100644 index 0000000..344cff6 --- /dev/null +++ b/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; + }; + }; + }; +} diff --git a/overlays/microvmp/.gitignore b/overlays/microvmp/.gitignore new file mode 100644 index 0000000..c368d45 --- /dev/null +++ b/overlays/microvmp/.gitignore @@ -0,0 +1,2 @@ +.stack-work/ +*~ \ No newline at end of file diff --git a/overlays/microvmp/CHANGELOG.md b/overlays/microvmp/CHANGELOG.md new file mode 100644 index 0000000..15e18bb --- /dev/null +++ b/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 diff --git a/overlays/microvmp/LICENSE b/overlays/microvmp/LICENSE new file mode 100644 index 0000000..ecdf6d0 --- /dev/null +++ b/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. diff --git a/overlays/microvmp/README.md b/overlays/microvmp/README.md new file mode 100644 index 0000000..e00a11d --- /dev/null +++ b/overlays/microvmp/README.md @@ -0,0 +1 @@ +# microvmp diff --git a/overlays/microvmp/Setup.hs b/overlays/microvmp/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/overlays/microvmp/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/overlays/microvmp/app/Main.hs b/overlays/microvmp/app/Main.hs new file mode 100644 index 0000000..272fd46 --- /dev/null +++ b/overlays/microvmp/app/Main.hs @@ -0,0 +1,6 @@ +module Main (main) where + +import Lib + +main :: IO () +main = libMain diff --git a/overlays/microvmp/default.nix b/overlays/microvmp/default.nix new file mode 100644 index 0000000..26891a1 --- /dev/null +++ b/overlays/microvmp/default.nix @@ -0,0 +1,7 @@ +{inputs, ...}: { + flake.overlays.microvmp = final: prev: { + microvmp = + final.python3.pkgs.callPackage ./microvmp.nix { + }; + }; +} diff --git a/overlays/microvmp/fourmolu.yaml b/overlays/microvmp/fourmolu.yaml new file mode 100644 index 0000000..355d9f1 --- /dev/null +++ b/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: [] + diff --git a/overlays/microvmp/hie.yaml b/overlays/microvmp/hie.yaml new file mode 100644 index 0000000..d8d0c3f --- /dev/null +++ b/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" diff --git a/overlays/microvmp/microvmp.cabal b/overlays/microvmp/microvmp.cabal new file mode 100644 index 0000000..e3568a1 --- /dev/null +++ b/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 +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 diff --git a/overlays/microvmp/microvmp.nix b/overlays/microvmp/microvmp.nix new file mode 100644 index 0000000..cfafd01 --- /dev/null +++ b/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 [flags] + + Actions: + -c Create a MicroVM + -u Rebuild (update) MicroVMs + -r Run a MicroVM in foreground + -l List MicroVMs + + Flags: + -f Create using another flake than $FLAKE + -p 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 + '' diff --git a/overlays/microvmp/package.yaml b/overlays/microvmp/package.yaml new file mode 100644 index 0000000..f6dfea2 --- /dev/null +++ b/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 + +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 diff --git a/overlays/microvmp/src/Lib.hs b/overlays/microvmp/src/Lib.hs new file mode 100644 index 0000000..e83e7c0 --- /dev/null +++ b/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 diff --git a/overlays/microvmp/src/SGR.hs b/overlays/microvmp/src/SGR.hs new file mode 100644 index 0000000..9144376 --- /dev/null +++ b/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 diff --git a/overlays/microvmp/stack.yaml b/overlays/microvmp/stack.yaml new file mode 100644 index 0000000..578f80b --- /dev/null +++ b/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 diff --git a/overlays/microvmp/stack.yaml.lock b/overlays/microvmp/stack.yaml.lock new file mode 100644 index 0000000..4046819 --- /dev/null +++ b/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 diff --git a/overlays/microvmp/test/Spec.hs b/overlays/microvmp/test/Spec.hs new file mode 100644 index 0000000..cd4753f --- /dev/null +++ b/overlays/microvmp/test/Spec.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Test suite not yet implemented"