Plack laminar magic
This commit is contained in:
Malte Brandy
parent
dc31655d64
commit
039210a6bb
|
|
@ -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";
|
||||
};
|
||||
};
|
||||
|
|
|
|||
|
|
@ -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/<name>
|
||||
'';
|
||||
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/<name>
|
||||
|
||||
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 = {
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
248
nixos/roles/laminar/nix-jobs.hs
Normal file
248
nixos/roles/laminar/nix-jobs.hs
Normal file
|
|
@ -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 <derivationName> | realise <derivationName>"
|
||||
|
|
@ -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));
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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 = {
|
||||
|
|
|
|||
|
|
@ -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 #-}
|
||||
|
|
|
|||
Loading…
Reference in a new issue