diff --git a/home-manager/roles/hoogle.nix b/home-manager/roles/hoogle.nix index 00697d4c..2b6b29b8 100644 --- a/home-manager/roles/hoogle.nix +++ b/home-manager/roles/hoogle.nix @@ -4,7 +4,7 @@ Unit.Description = "Hoogle server"; Install.WantedBy = [ "graphical-session.target" ]; Service = { - ExecStart = "${pkgs.ghc}/bin/hoogle server --local --links"; + ExecStart = "${pkgs.ghcWithPackages}/bin/hoogle server --local --links"; Restart = "always"; }; }; diff --git a/nixos/roles/laminar/default.nix b/nixos/roles/laminar/default.nix index 45e4266e..b4311f92 100644 --- a/nixos/roles/laminar/default.nix +++ b/nixos/roles/laminar/default.nix @@ -1,22 +1,42 @@ { pkgs, lib, config, ... }: let - types = lib.types; + inherit (lib) types mkOption; stateDir = "/var/lib/laminar"; - jobsDir = "${stateDir}/cfg/jobs"; + cfgDir = "${stateDir}/cfg"; cfg = config.services.laminar; in { options = { - services.laminar.jobs = lib.mkOption { - type = lib.types.attrsOf lib.types.path; - default = { }; - description = '' - CI jobs statically known to laminar. - Every attribute will be copied to /var/lib/laminar/cfg/jobs/ - ''; + services.laminar = { + cfgFiles = mkOption { + type = let valueType = with types; oneOf [ path (attrsOf valueType) ]; + in valueType; + default = { }; + description = '' + Every entry will be copied to /var/lib/laminar/cfg/ + + Can be used to define jobs, helper scripts, etc. + ''; + }; }; }; - imports = [./kassandra.nix ]; + imports = [ ./kassandra.nix ]; config = { + services.laminar.cfgFiles = { + scripts = { + "nix-jobs" = pkgs.writeHaskell "nix-jobs" { + libraries = builtins.attrValues pkgs.myHaskellScriptPackages; + ghcEnv = { + PATH = "${lib.makeBinPath [ pkgs.laminar pkgs.nix ]}:$PATH"; + }; + } (builtins.readFile ./nix-jobs.hs); + }; + jobs = { + "nix-build.run" = pkgs.writeShellScript "nix-build" '' + set -e + nix-jobs realize-here "$DERIVATION" + ''; + }; + }; users = { groups.laminar = { }; users.laminar = { @@ -36,11 +56,17 @@ in { StateDirectory = "laminar"; }; after = [ "network.target" ]; - preStart = '' - mkdir -p ${jobsDir} - ${lib.concatStrings (lib.mapAttrsToList (key: value: '' - ln -sf ${value} ${jobsDir}/${key} - '') cfg.jobs)}''; + preStart = let + linkToPath = path: fileOrDir: + (if types.path.check fileOrDir then + [ "ln -sT ${fileOrDir} ${path}" ] + else + [ "mkdir -p ${path}" ] ++ lib.concatLists (lib.mapAttrsToList + (dirName: content: linkToPath "${path}/${dirName}" content) + fileOrDir)); + cfgDirContent = pkgs.runCommand "laminar-cfg-dir" { } + (lib.concatStringsSep "\n" (linkToPath "$out" cfg.cfgFiles)); + in "ln -sfT ${cfgDirContent} ${cfgDir}"; }; services = { nginx = { diff --git a/nixos/roles/laminar/kassandra.nix b/nixos/roles/laminar/kassandra.nix index bab27dc6..48139043 100644 --- a/nixos/roles/laminar/kassandra.nix +++ b/nixos/roles/laminar/kassandra.nix @@ -5,14 +5,15 @@ let export PATH=${lib.makeBinPath path}:$PATH ''; target = name: '' - set -ex + set -e ${setup} export HOME=$PWD git clone git@localhost:kassandra2 kassandra - nix-build --no-out-link kassandra/release.nix -A ${name} + DRV=$(nix-instantiate kassandra/release.nix -A ${name} --add-root ./drv --indirect) + nix-jobs realise "DERIVATION=$DRV" ''; in { - services.laminar.jobs = { + services.laminar.cfgFiles.jobs = { "kassandra.run" = pkgs.writeShellScript "kassandra" '' ${setup} echo Launching and waiting for jobs lib, app, android and server diff --git a/nixos/roles/laminar/nix-jobs.hs b/nixos/roles/laminar/nix-jobs.hs new file mode 100644 index 00000000..54e1b377 --- /dev/null +++ b/nixos/roles/laminar/nix-jobs.hs @@ -0,0 +1,248 @@ +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ExtendedDefaultRules #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_GHC -Wall -Werror -Wno-missing-signatures -Wno-type-defaults -Wno-orphans #-} + +import Control.Concurrent ( threadDelay ) +import Control.Concurrent.Async ( forConcurrently ) +import Control.Exception ( IOException + , bracket + , catch + , handle + ) +import Data.Bits ( Bits((.|.)) ) +import qualified Data.Sequence as Seq +import Data.String.Interpolate ( i ) +import qualified Data.Text as T +import Relude +import Say ( say + , sayErr + ) +import Shh ( ExecArg + , ExecReference(Absolute) + , captureTrim + , load + , (|>) + ) +import System.Directory ( doesFileExist + , removeFile + ) +import System.Environment ( getArgs + , getEnv + ) +import System.FSNotify ( Event(Removed) + , stopManager + , watchDir + , withManager + ) +import System.Posix.Files ( groupReadMode + , otherReadMode + , ownerReadMode + , ownerWriteMode + ) +import System.Posix.IO ( OpenFileFlags(exclusive) + , OpenMode(WriteOnly) + , closeFd + , defaultFileFlags + , fdWrite + , openFd + ) + + +load Absolute ["laminarc", "nix-store"] + +data JobResult = Success | Failure deriving (Show, Read, Eq, Ord, Enum) + +instance Semigroup JobResult where + Success <> Success = Success + _ <> _ = Failure + +instance Monoid JobResult where + mempty = Success +-- 2 Entry points +-- 1. Realise i.e. "wait-for-and-trigger-build-if-necessary" +-- 2. Job i.e. "the actual realisation" + +instance ExecArg Text where + +getDependenciesFromNix :: Text -> IO (Seq Text) +getDependenciesFromNix derivationName = do + everythingToDo <- nixStoreRealiseDryRun derivationName + pure (Seq.filter (/= derivationName) everythingToDo) + +nixStoreRealiseDryRun :: Text -> IO (Seq Text) +nixStoreRealiseDryRun derivationName = + process <$> (nix_store "-r" derivationName "--dry-run" |> captureTrim) + where + process = + fromList + . dropWhile (/= "these derivations will be built:") + . fmap T.strip + . lines + . decodeUtf8 + +job :: Text -> IO () +job derivationName = do + say [i|Initiating realisation for #{derivationName}.|] + pathInfo <- getPathInfo derivationName + let setResult result = do + writeFileText (resultPath pathInfo) (show result) + removeFile (runningPath pathInfo) + ensureDeps True derivationName >>= \case + Success -> do + say [i|All dependencies provided, starting build for #{derivationName}.|] + catch + (nixStoreRealise derivationName) + (\(err :: SomeException) -> do + setResult Failure + sayErr [i|nix-build failed with error #{err}.|] + exitFailure + ) + setResult Success + say [i|Build for #{derivationName} successful. Finishing.|] + Failure -> do + sayErr + [i|Couldnā€˜t build #{derivationName} because of failing dependency.|] + +nixStoreRealise :: Text -> IO () +nixStoreRealise = nix_store "-r" + +ensureDeps :: Bool -> Text -> IO JobResult +ensureDeps topLevel derivationName = do + dependencies <- getDependenciesFromNix derivationName + when topLevel $ forM_ dependencies $ \dep -> + say [i|Requiring build of #{dep}.|] + fold <$> forConcurrently dependencies (realise topLevel) + +-- Nothing means failing to acquire lock on the derivation name for starting the job. +tryQueue :: PathInfo -> IO (Maybe Text) +tryQueue pathInfo@(_, _, derivationName) = getRunningJob pathInfo >>= \case + Nothing -> handle handleIOException $ bracket openNewFile closeFd $ \fd -> do + jobName <- + decodeUtf8 + <$> ( laminarc "queue" "nix-build" ([i|DERIVATION=#{derivationName}|] :: Text) + |> captureTrim + ) + writeCount <- fdWrite fd (toString jobName) + when (writeCount == 0) $ sayErr + [i|Wrote 0 bytes of jobName "#{jobName}" to #{runningPath pathInfo}|] + pure (Just jobName) + Just _ -> pure Nothing + where + openNewFile = openFd (runningPath pathInfo) + WriteOnly + (Just defaultMode) + defaultFileFlags { exclusive = True } + defaultMode = + ownerReadMode .|. ownerWriteMode .|. groupReadMode .|. otherReadMode + handleIOException :: IOException -> IO (Maybe Text) + handleIOException _ = pure Nothing + +-- Nothing means a dependency failed. +queueJobWithLaminarc :: Bool -> PathInfo -> IO (Maybe Text) +queueJobWithLaminarc topLevel pathInfo@(_, _, derivationName) = + tryQueue pathInfo >>= \case + Nothing -> ensureRunningJob topLevel pathInfo + a -> do + say [i|Queued build job ${jobName} for #{derivationName}.|] + pure a + +ensureRunningJob :: Bool -> PathInfo -> IO (Maybe Text) +ensureRunningJob topLevel pathInfo@(_, _, derivationName) = + getRunningJob pathInfo >>= \case + Nothing -> do + ensureDeps False derivationName >>= \case + Success -> queueJobWithLaminarc topLevel pathInfo + Failure -> do + sayErr + [i|Could not realise #{derivationName} because of failed dependency.|] + pure Nothing + Just jobName -> do + when topLevel + $ say [i|Waiting for job #{jobName} running for #{derivationName}|] + pure (Just jobName) + + +type PathInfo = (Text, Text, Text) + +getPathInfo :: Text -> IO PathInfo +getPathInfo derivationName = do + workSpace <- toText <$> getEnv "WORKSPACE" + (workSpace, , derivationName) + . decodeUtf8 + <$> (nix_store "-q" "--hash" derivationName |> captureTrim) + +runningDir :: PathInfo -> String +runningDir (workSpace, _, _) = [i|#{workSpace}/running-jobs|] +runningPath :: PathInfo -> String +runningPath (workSpace, drvHash, _) = [i|#{workSpace}/running-jobs/#{drvHash}|] +resultPath :: PathInfo -> String +resultPath (workSpace, drvHash, _) = + [i|#{workSpace}/completed-jobs/#{drvHash}|] + +-- Nothing means there is no running Job. +getRunningJob :: PathInfo -> IO (Maybe Text) +getRunningJob p = do + let path = runningPath p + pathExists <- doesFileExist path + if pathExists + then catch (Just <$> readFileText path) + (\(_ :: IOException) -> getRunningJob p) + else pure Nothing + +realise :: Bool -> Text -> IO JobResult +realise topLevel derivationName = do + pathInfo <- getPathInfo derivationName + jobNameMay <- ensureRunningJob topLevel pathInfo + case jobNameMay of + Just jobName -> do + result <- waitForJob pathInfo + case result of + Success -> when topLevel + $ say [i|#{derivationName} succesfully realised by job #{jobName}|] + Failure -> sayErr [i|#{derivationName} failed in job #{jobName}|] + pure result + Nothing -> pure Failure + +waitForJob :: PathInfo -> IO JobResult +waitForJob pathInfo = do + _ <- withManager $ \manager -> do + _ <- watchDir manager + (runningDir pathInfo) + fileDeleted + (const $ stopManager manager) + maybeJob <- getRunningJob pathInfo + whenNothing_ maybeJob $ stopManager manager + forever $ threadDelay 1000000 + readFileText (resultPath pathInfo) + >>= (\case + Nothing -> do + sayErr [i|Failed to parse result from #{resultPath pathInfo}|] + pure Failure + Just a -> pure a + ) + . readMaybe + . toString + where + fileDeleted (Removed a _ _) | a == runningPath pathInfo = True + fileDeleted _ = False + + +main :: IO () +main = do + whenNotNullM missingExecutables $ \x -> do + sayErr [i|Missing executables #{show x}|] + exitFailure + args <- fmap toText <$> getArgs + case args of + ["realise-here", derivationName] -> job derivationName + ["realise" , derivationName] -> realise True derivationName >>= \case + Success -> exitSuccess + Failure -> exitFailure + _ -> + sayErr "Usage: realise-here | realise " diff --git a/overlays/30-ghc.nix b/overlays/30-ghc.nix index b02c50dc..4d9fb320 100644 --- a/overlays/30-ghc.nix +++ b/overlays/30-ghc.nix @@ -3,12 +3,10 @@ let inherit (super) fetchFromGitHub; master = import super.sources.nixpkgs-master { }; inherit (master.haskell.lib) overrideCabal unmarkBroken; - myOverrides = self: super: { - }; makeHaskellScriptPackages = p: { inherit (p) aeson shh string-interpolate relude replace-megaparsec async say - megaparsec fdo-notify these; + megaparsec fdo-notify these fsnotify; }; makeHaskellPackages = p: { @@ -18,12 +16,11 @@ let cabal2nix weeder reflex-dom password optics shh-extras neuron hspec-discover cabal-edit paths hmatrix; } // makeHaskellScriptPackages p; + inherit (master) ghc haskellPackages; in { + inherit ghc haskellPackages; nix-output-monitor = master.nix-output-monitor; - myHaskellPackages = makeHaskellPackages master.haskellPackages; - scriptGhc = master.ghc.withPackages - (p: builtins.attrValues (makeHaskellScriptPackages p)); - ghc = (master.haskellPackages.override { - overrides = myOverrides; - }).ghc.withHoogle (p: builtins.attrValues (makeHaskellPackages p)); + myHaskellPackages = makeHaskellPackages haskellPackages; + myHaskellScriptPackages = makeHaskellScriptPackages haskellPackages; + ghcWithPackages = ghc.withHoogle (p: builtins.attrValues (makeHaskellPackages p)); } diff --git a/overlays/pkgSets.nix b/overlays/pkgSets.nix index 62e2ebc7..0fbb8d87 100644 --- a/overlays/pkgSets.nix +++ b/overlays/pkgSets.nix @@ -43,7 +43,7 @@ self: super: { inherit (self.pythonPackages) yapf jsbeautifier; inherit (self) go gdb mpc_cli ncmpcpp shfmt htmlTidy astyle nodejs tasksh magic-wormhole - nixfmt nixpkgs-fmt rnix-lsp tmate rustup kitty nix-top ghc ghcid; + nixfmt nixpkgs-fmt rnix-lsp tmate rustup kitty nix-top ghcWithPackages ghcid; obelisk = (import self.sources.obelisk { }).command; }; accounting-pkgs = { diff --git a/overlays/writeHaskellScript.nix b/overlays/writeHaskellScript.nix index e81ef4e6..1d1bd1a0 100644 --- a/overlays/writeHaskellScript.nix +++ b/overlays/writeHaskellScript.nix @@ -1,15 +1,49 @@ -self: super: { +self: super: +let inherit (self) lib pkgs; +in { haskellList = list: ''["${builtins.concatStringsSep ''", "'' list}"]''; + # writeHaskell takes a name, an attrset with libraries and haskell version (both optional) + # and some haskell source code and returns an executable. + # + # Example: + # writeHaskell "missiles" { libraries = [ pkgs.haskellPackages.acme-missiles ]; } '' + # import Acme.Missiles + # + # main = launchMissiles + # ''; + writeHaskell = name: + { libraries ? [ ], ghc ? pkgs.ghc, ghcArgs ? [ ], ghcEnv ? { } }: + pkgs.writers.makeBinWriter { + compileScript = let filename = lib.last (builtins.split "/" name); + in '' + cp $contentPath ${filename}.hs + ${ + lib.concatStringsSep " " + (lib.mapAttrsToList (key: val: "${key}=${val}") ghcEnv) + } ${ghc.withPackages (_: libraries)}/bin/ghc ${ + lib.escapeShellArgs ghcArgs + } ${filename}.hs + mv ${filename} $out + ${pkgs.binutils-unwrapped}/bin/strip --strip-unneeded "$out" + ''; + } name; + + # writeHaskellBin takes the same arguments as writeHaskell but outputs a directory (like writeScriptBin) + writeHaskellBin = name: pkgs.writeHaskell "/bin/${name}"; writeHaskellScript = { name ? "haskell-script", bins ? [ ], imports ? [ ] }: code: - self.writers.makeBinWriter { - compileScript = '' - cp $contentPath ${name}.hs - ${self.scriptGhc}/bin/ghc ${name}.hs -threaded -Wall -Wno-unused-top-binds -Wno-missing-signatures -Wno-type-defaults -Wno-unused-imports -Werror - mv ${name} $out - ${self.binutils-unwrapped}/bin/strip --strip-unneeded "$out" - ''; - } "/bin/${name}" '' + pkgs.writeHaskellBin name { + ghcArgs = [ + "-threaded" + "-Wall" + "-Wno-unused-top-binds" + "-Wno-missing-signatures" + "-Wno-type-defaults" + "-Wno-unused-imports" + "-Werror" + ]; + libraries = builtins.attrValues pkgs.myHaskellScriptPackages; + } '' {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE QuasiQuotes #-}