diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,5 @@ +# Revision history for hail + +## 0.1.0.0 -- 2017-04-08 + +* Initial release diff --git a/Hail/Hydra.hs b/Hail/Hydra.hs new file mode 100644 --- /dev/null +++ b/Hail/Hydra.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE OverloadedStrings #-} +module Hail.Hydra where + +import Control.Exception (handle) + +import Network.Wreq +import Network.HTTP.Client (HttpException) +import Data.Aeson.Lens +import Control.Lens.Operators +import Data.Text (unpack) + +-- | Get the out path of the latest build of a given hydra job. +getLatest + :: String -- ^ The URI to the hydra job. + -> Maybe Auth -- ^ The credentials to talk to hydra. + -> IO (Either String FilePath) +getLatest uri m_creds = + handle (return . Left . (show :: HttpException -> String)) $ do + r <- getWith opts latestUri + let m_outPath = r ^? responseBody . key "buildoutputs" + . key "out" + . key "path" . _String + return $ case m_outPath of + Nothing -> Left noOutErr + Just outPath -> Right $ unpack outPath + where + opts = defaults & header "Accept" .~ ["application/json"] + & auth .~ m_creds + noOutErr = + "Latest build of job " ++ uri + ++ " has no output named 'out'." + latestUri = uri ++ "/latest" diff --git a/Hail/Netrc.hs b/Hail/Netrc.hs new file mode 100644 --- /dev/null +++ b/Hail/Netrc.hs @@ -0,0 +1,64 @@ +{-# LANGUAGE LambdaCase #-} +module Hail.Netrc (loadCredsFromNetrc) where + +import Control.Monad (join) +import Data.Foldable (find) +import Data.Maybe (fromMaybe) +import System.IO.Error (tryIOError) + +import Network.NetRc +import Network.URI +import Network.Wreq (basicAuth, Auth) +import Text.Parsec.Error (ParseError) +import Data.ByteString.Char8 as BS (null, pack) +import Text.Parsec.ByteString (parseFromFile) +import Control.Lens.Operators + +-- | Load credentials for a given URI from the netrc file. +-- +-- Users of this function cannot distinguish a missing/malformed +-- netrc file from one without an entry for their URI. +loadCredsFromNetrc + :: Maybe FilePath -- ^ The path to the netrc file. + -- + -- Defaults to "/etc/netrc". + -> String -- ^ The URI to look up. + -> IO (Maybe Auth) +loadCredsFromNetrc m_file uri = + (tryIOError $ loadCredsFromFile file uri) <&> \case + Right (Right m_auth) -> m_auth + _ -> Nothing + where + file = fromMaybe "/etc/netrc" m_file + +-- | Load credentials for a given URI from a given file. +loadCredsFromFile + :: FilePath + -> String -- ^ The URI to look up. + -> IO (Either ParseError (Maybe Auth)) +loadCredsFromFile file uri = lookupAuthInNetrc uri <$$> netrc + where + netrc = parseFromFile netRcParsec file + -- This belongs somewhere else... + (<$$>) = fmap . fmap + +-- | Find credentials for a given URI in a 'NetRc'. +lookupAuthInNetrc + :: String -- ^ The URI to look up. + -> NetRc + -> Maybe Auth +lookupAuthInNetrc uri rc = + basicAuth <$> nrhLogin <*> nrhPassword <$> m_rcHost + where + -- Extract the authority from the URI + m_authority = join $ uriAuthority <$> parseURI uri + -- Extract the reg name from the authority + m_regName = uriRegName <$> m_authority + -- Predicate determining if a 'NetRcHost' matches a regName + nameMatch regName (NetRcHost nm _ _ _ _) = + -- A 'null' name means the default entry + nm == regName || BS.null nm + -- Find a matching rcHost based on the regName + m_rcHost = case m_regName of + Nothing -> Nothing + Just regName -> find (nameMatch $ pack regName) $ nrHosts rc diff --git a/Hail/Nix.hs b/Hail/Nix.hs new file mode 100644 --- /dev/null +++ b/Hail/Nix.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE LambdaCase #-} +module Hail.Nix where + +import System.Exit (ExitCode(..)) +import System.IO (hPutStrLn, stderr) +import System.IO.Error (tryIOError) + +import System.Process (spawnProcess, waitForProcess, callProcess) +import System.FilePath (()) + +-- | Run the activation script for a profile. +-- +-- Errors are logged to stderr. +activate + :: FilePath -- ^ The path to the profile + -> ActivateErrorMode + -> IO () +activate profilePath error_mode = do + e_pid <- tryIOError $ spawnProcess activateCommand [] + case e_pid of + Left err -> + logger $ "spawning activation command failed: " ++ show err + Right pid -> do + code <- waitForProcess pid + case code of + ExitSuccess -> return () + ExitFailure i -> logger $ + "activation command exited with non-zero code " ++ show i + where + logger = case error_mode of + ActivateIgnoreErrors -> const $ return () + ActivateReportErrors -> hPutStrLn stderr + activateCommand = profilePath "bin/activate" + +-- | Settings for error handling for 'activate'. +data ActivateErrorMode + = ActivateIgnoreErrors -- ^ Ignore errors. + | ActivateReportErrors -- ^ Log errors to stderr. + +-- | Update a profile to point to a given store path. +-- +-- The store path is realised if necessary. +-- +-- Errors are logged to stderr. +switchProfile + :: FilePath -- ^ The profile. + -> FilePath -- ^ The store path. + -> IO Bool -- ^ Whether the update succeeded. +switchProfile profilePath outPath = tryIOError switch >>= \case + Left err -> do + hPutStrLn stderr $ "Switching " ++ profilePath ++ " to " + ++ outPath ++ " failed: " ++ (show err) + return False + Right () -> return True + where + -- TODO Hard-code path to nix-env? + switch = callProcess "nix-env" [ "--profile", profilePath + , "--set", outPath + ] diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,202 @@ + + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + + APPENDIX: How to apply the Apache License to your work. + + To apply the Apache License to your work, attach the following + boilerplate notice, with the fields enclosed by brackets "[]" + replaced with your own identifying information. (Don't include + the brackets!) The text should be enclosed in the appropriate + comment syntax for the file format. We also recommend that a + file or class name and description of purpose be included on the + same "printed page" as the copyright notice for easier + identification within third-party archives. + + Copyright 2017 Takt Inc. + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. diff --git a/Main.hs b/Main.hs new file mode 100644 --- /dev/null +++ b/Main.hs @@ -0,0 +1,118 @@ +{-# LANGUAGE LambdaCase #-} +module Main where + +import Control.Monad (when) +import Control.Applicative ((<*>)) +import Control.Concurrent (threadDelay) +import Data.Semigroup ((<>)) +import System.IO (hPutStrLn, stderr) + +import System.FilePath ((), takeDirectory) + +import System.Directory (canonicalizePath, createDirectoryIfMissing) + +import Options.Applicative + +import Network.Wreq (Auth) + +import Hail.Netrc +import Hail.Nix +import Hail.Hydra + +-- | Command line options +data Opts = Opts + { profile :: String -- ^ The profile to install the + -- service into. + , jobURI :: String -- ^ The job to poll. + , netrcFile :: Maybe FilePath -- ^ The netrc file for hydra access. + , pollPeriod :: Maybe Int -- ^ The period to poll the job, in + -- minutes, or 'Nothing' for a oneshot. + } + +-- | Parser for the poll period command line flag +pollPeriodParser :: Parser (Maybe Int) +pollPeriodParser = Just + <$> option auto + ( long "poll-period" + <> metavar "PERIOD" + <> help "The period with which to poll, in minutes" + <> value 5 + <> showDefault) + +-- | Parser for the oneshot command line flag +oneshotParser :: Parser (Maybe Int) +oneshotParser = flag' Nothing + ( long "oneshot" + <> help "Just update once, rather than in a loop" + ) + +-- | Parser for command line options +optsParser :: Parser Opts +optsParser = Opts + <$> strOption + ( long "profile" + <> metavar "PROFILE" + <> help "The nix profile to install the service into") + <*> strOption + ( long "job-uri" + <> metavar "HYDRA_JOB_URI" + <> help "The hydra job to poll") + <*> (optional $ strOption + ( long "netrc-file" + <> metavar "NETRC_FILE" + <> help "The netrc file for hydra HTTP access")) + <*> (oneshotParser <|> pollPeriodParser) + +-- | Full command line parser with usage string. +optsParserInfo :: ParserInfo Opts +optsParserInfo = info (optsParser <**> helper) + ( fullDesc + <> progDesc "Pull builds from HYDRA_JOB_URI into PROFILE" + <> header "hail - Pull-based continuous deployment from hydra") + +main :: IO () +main = do + opts <- execParser optsParserInfo + let profilePath = "/nix/var/nix/profiles" (profile opts) + uri = jobURI opts + cont m_creds = case pollPeriod opts of + Nothing -> const $ return () + Just period -> \delay -> do + case delay of + Delay -> threadDelay $ minutesToMicroseconds period + NoDelay -> return () + pollLoop profilePath uri m_creds (cont m_creds) + m_creds <- loadCredsFromNetrc (netrcFile opts) uri + createDirectoryIfMissing True $ takeDirectory profilePath + -- Try to activate on initial startup, but ignore failures. + activate profilePath ActivateIgnoreErrors + cont m_creds NoDelay + +-- | Convert minutes to microseconds +minutesToMicroseconds :: Int -> Int +minutesToMicroseconds = (*) $ 60 * 1000000 + +-- | Whether the looping continuation should delay before +-- the next iteration of the loop. +data ShouldDelay = Delay | NoDelay + +-- | Poll hydra for new builds, with an explicit continuation +pollLoop :: FilePath -- ^ The profile path + -> String -- ^ The job URI + -> Maybe Auth -- ^ The creds for talking to hydra + -> (ShouldDelay -> IO ()) -- ^ The continuation + -> IO () +pollLoop profilePath uri m_creds cont = + getLatest uri m_creds >>= \case + Left msg -> do + hPutStrLn stderr msg + cont Delay + Right outPath -> do + prevOutPath <- canonicalizePath profilePath + case prevOutPath /= outPath of + True -> do + switchSucceeded <- switchProfile profilePath outPath + when switchSucceeded $ + activate profilePath ActivateReportErrors + cont NoDelay + False -> cont Delay diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/hail-systemd-bootstrap.nix b/hail-systemd-bootstrap.nix new file mode 100644 --- /dev/null +++ b/hail-systemd-bootstrap.nix @@ -0,0 +1,125 @@ +# | Build a profile usable by 'hail' to spin up 'hail' instances for +# a set of services on systemd-based systems. +# +# The profiles generated live in the 'hail-profiles' nix profile +# subdirectory +# +# Example: Create a hydra jobset 'infra.staging' with job 'foo-bar-box' +# defined by: +# let hail-systemd-bootstrap = pkgs.callPackage ./hail-systemd-bootstrap.nix {}; +# in +# hail-systemd-bootstrap +# { services = +# { foo = "https://hydra.example.com/job/foo/staging/foo"; +# bar = "https://hydra.example.com/job/foo/staging/bar"; +# hail-services = "https://hydra.example.com/job/infra/staging/foo-bar-box"; +# }; +# } +# On first init, if you don't already have a 'hail-hail-services' service +# that points to https://hydra.example.com/job/infra/staging/foo-bar-box, +# you will need to manually pull down a build of that job and run the +# 'activate' script. +# +# Then, your box will always have the 'staging' versions of foo and bar +# running, at least until you update your 'foo-bar-box' job to change +# the service set. +let pkgs = import {}; +in + { writeScriptBin ? pkgs.writeScriptBin + , writeTextDir ? pkgs.writeTextDir + , hail ? null # : Nullable Package + # ^ The package containing the 'hail' program, or + # 'null' to use the hail program this nix expression + # is distributed with + , nix ? pkgs.nix + , bash ? pkgs.bash + , coreutils ? pkgs.coreutils + , systemd ? pkgs.systemd + , runCommand ? pkgs.runCommand + , setupSystemdUnits ? pkgs.setupSystemdUnits + , lib ? pkgs.lib + }: + { services # : AttrSet String (Either URI { job-uri : URI + # , netrc-file : Optional Path + # , poll-period : Optional Int + # }) + # ^ A set whose names are + # profile names and values + # are either a set of hail + # options (see README.md + # for semantics and + # defaults) or hydra job + # URIs + , target ? "multi-user" # : String + # ^ The systemd target that + # the hail services should + # be Wanted-By, or null for + # none. + , namespace ? "hail-systemd-bootstrap" # : String + # ^ The namespace the + # services managed by hail + # should live in. See the + # analogous argument to + # setupSystemdUnits in + # nixpkgs. + }: + let # Haaaaacky + this-hail-bin = + if builtins.pathExists ./hail.cabal + then "${toString ./.}/dist/build/hail/hail" + else + let found = lib.locateDominatingFile "bin" ./.; + in if found == null + then throw "Could not find hail executable" + else builtins.storePath + "${toString found.path}/bin/hail"; + hail-bin = if hail == null + then this-hail-bin + else "${hail}/bin/hail"; + mk-unit = profile: opts: + let uri = if builtins.isAttrs opts + then opts.job-uri + else opts; + netrc-string = lib.optionalString (opts ? netrc-file) + " --netrc-file ${opts.netrc-file}"; + period-string = lib.optionalString (opts ? poll-period) + " --poll-period ${toString opts.poll-period}"; + in + writeTextDir "hail-${profile}.service" + '' + [Unit] + Description=Hail continuous self-deployment service for ${profile} + Wants=network-online.target + + [Service] + Environment="PATH=${nix}/bin" + Environment="HOME=/var/lib/empty" + ExecStart=@${hail-bin} hail --profile hail-profiles/${profile} --job-uri ${uri}${netrc-string}${period-string} + ''; + setup-systemd-units = setupSystemdUnits + { units = lib.mapAttrs' (profile: opts: + rec { name = "hail-${profile}.service"; + value = + { path = "${mk-unit profile opts}/${name}"; + wanted-by = if target == null + then [] + else [ "${target}.target" ]; + }; + } + ) services; + inherit namespace; + }; + activate = writeScriptBin "activate" + '' + #!${bash}/bin/bash -e + # We use systemd-run because the program calling this + # script may be one of the services being updated. + exec -a systemd-run ${systemd}/bin/systemd-run \ + --description="Update hail services" \ + ${setup-systemd-units}/bin/setup-systemd-units + ''; + in runCommand "hail-profile" {} '' + mkdir -p $out/bin + ln -sv ${activate}/bin/activate $out/bin + ln -sv ${hail-bin} $out/bin/hail + '' diff --git a/hail.cabal b/hail.cabal new file mode 100644 --- /dev/null +++ b/hail.cabal @@ -0,0 +1,43 @@ +name: hail +version: 0.1.0.0 +synopsis: + A service for pull-based continuous deployment based on hydra. +description: + Point hail to a hydra job, set up your nix-daemon to pull + from your hydra's cache, and hail will automatically pull + the latest results from the job and activate them. + + See the README for more details. +homepage: https://github.com/TaktInc/hail +license: Apache-2.0 +license-file: LICENSE +author: Shea Levy +maintainer: shea.levy@takt.com +copyright: (c) 2017, Takt Inc. +category: System +build-type: Simple +extra-source-files: ChangeLog.md +cabal-version: >=1.10 +data-files: hail-systemd-bootstrap.nix + +executable hail + main-is: Main.hs + other-modules: Hail.Hydra, + Hail.Netrc, + Hail.Nix + build-depends: base >=4.9 && <4.10, + bytestring >=0.10.8 && <0.11, + directory >=1.3.0 && <1.4, + filepath >=1.4.1 && <1.5, + http-client >=0.5.6 && <0.6, + lens >=4.15.1 && <4.16, + lens-aeson >=1.0.0 && <1.1, + netrc >=0.2.0.0 && <0.3, + network-uri >=2.6.1 && <2.7, + optparse-applicative >=0.13.1 && <0.14, + parsec >=3.1.11 && <3.2, + process >=1.4.3 && <1.5, + text >=1.2.2 && <1.3, + wreq >=0.5 && <0.6 + default-language: Haskell2010 + ghc-options: -Wall