diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,5 @@ +# Revision history for funflow-nix + +## 0.1.0.0 -- 2018-11-16 + +* Initial Release diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2018, Matthew Pickering + +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 Matthew Pickering 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/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,36 @@ +`funflow-nix` provides functions for creating flows which run in a nix +environment. + +The library exposes the `NixConfig` data type which allows you to specify the +environment and command to run. This is then turned into a flow using `nix`. + +A complete example can be seen in `examples/Simple.hs`. + +We can pin the version of nixpkgs we want to use by specifying a tarball to +use as the source. + +``` +tarballSource :: NixpkgsSource +tarballSource = NixpkgsTarball [uri|https://github.com/NixOS/nixpkgs/archive/a19357241973538212b5cb435dde84ad25cbe337.tar.gz|] + +nixConfig :: Environment -> NixConfig +nixConfig senv = + NixShellConfig { + environment = senv + , command = "jq" + , args = [ParamText "--version"] + , env = [] + , stdout = StdOutCapture + , nixpkgsSource = tarballSource + } +``` + +Once the config has been specified. It can be turned into a flow by using the +`nix` function. + + +``` +jqVersionPkg :: SimpleFlow () String +jqVersionPkg = readString_ <<< nix (\() -> nixConfig (PackageList ["jq"])) +``` + 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/examples/Simple.hs b/examples/Simple.hs new file mode 100644 --- /dev/null +++ b/examples/Simple.hs @@ -0,0 +1,56 @@ +{-# LANGUAGE Arrows #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +module Main(main) where + +import Control.Arrow +import Control.Funflow +import Control.Funflow.ContentHashable +import Path +import Path.IO +import Control.Funflow.External.Nix +import Text.URI.QQ + +nixConfig :: (NixpkgsSource, Environment) -> NixConfig +nixConfig (nps, senv) = + NixShellConfig { + environment = senv + , command = "jq" + , args = [ParamText "--version"] + , env = [] + , stdout = StdOutCapture + , nixpkgsSource = nps + } + +jqVersion :: SimpleFlow NixpkgsSource String +jqVersion = proc np -> do + cwd <- stepIO (const getCurrentDir) -< () + shellScript <- copyFileToStore + -< (FileContent (cwd [relfile|data/shell.nix|]) + ,[relfile|data/shell.nix|]) + readString_ <<< nix nixConfig -< (np, ShellFile shellScript) + +jqVersionPkg :: SimpleFlow NixpkgsSource String +jqVersionPkg = readString_ <<< nix (\np -> nixConfig (np, PackageList ["jq"])) + +tarballSource :: NixpkgsSource +tarballSource = NixpkgsTarball [uri|https://github.com/NixOS/nixpkgs/archive/a19357241973538212b5cb435dde84ad25cbe337.tar.gz|] + +mainFlow :: SimpleFlow () (String, String) +mainFlow = proc _ -> do + s1 <- jqVersion -< tarballSource + s2 <- jqVersionPkg -< NIX_PATH + returnA -< (s1, s2) + +main :: IO () +main = do + cwd <- getCurrentDir + r <- withSimpleLocalRunner (cwd [reldir|funflow-example/store|]) $ \run -> + run mainFlow () + case r of + Left err -> + putStrLn $ "FAILED" ++ show err + Right out -> do + putStrLn $ "SUCCESS" + print out + diff --git a/funflow-nix.cabal b/funflow-nix.cabal new file mode 100644 --- /dev/null +++ b/funflow-nix.cabal @@ -0,0 +1,75 @@ +-- Initial funflow-nix.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: funflow-nix +version: 0.1.0.0 +synopsis: Utility functions for using funflow with nix +description: This library provides functions to create flows which run commands + in environments created by nix commands. + It is designed to be like the docker integration but the environments + are created by nix rather than in a container. +license: BSD3 +license-file: LICENSE +author: Matthew Pickering +maintainer: matthewtpickering@gmail.com +-- copyright: +-- category: +build-type: Simple +extra-source-files: ChangeLog.md, README.md +cabal-version: >=1.10 +tested-with: GHC==8.2.2 + +source-repository head + type: git + location: https://github.com/mpickering/funflow-nix.git + +flag example + Description: Build the example executable + Default: False + Manual: True + +library + exposed-modules: Control.Funflow.External.Nix + -- other-modules: + -- other-extensions: + build-depends: base >=4.10 && < 5, funflow >= 1.4, text, path, modern-uri + hs-source-dirs: src + ghc-options: -Wall + default-language: Haskell2010 + + +executable example + if flag(example) + buildable: True + else + buildable: False + main-is: examples/Simple.hs + build-depends: funflow, funflow-nix, path, path-io, modern-uri, base < 5 + ghc-options: -Wall + default-language: Haskell2010 + +Test-suite unit-tests + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: tests + main-is: Test.hs + other-modules: TestFlows + ghc-options: -Wall -threaded + build-depends: base < 5 + , async + , containers + , data-default >= 0.7 + , directory + , filepath + , funflow + , funflow-nix + , path + , path-io + , process + , random + , safe-exceptions + , tasty + , tasty-hunit + , temporary + , unix + , modern-uri diff --git a/src/Control/Funflow/External/Nix.hs b/src/Control/Funflow/External/Nix.hs new file mode 100644 --- /dev/null +++ b/src/Control/Funflow/External/Nix.hs @@ -0,0 +1,73 @@ +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE DeriveGeneric #-} +module Control.Funflow.External.Nix + ( NixConfig(..) + , NixpkgsSource(..) + , Environment(..) + , nix )where + +import Control.Funflow +import Path +import Control.Funflow.ContentHashable +import Control.Funflow.ContentStore as CS +import Control.Funflow.External as E +import Data.Semigroup ((<>)) +import qualified Data.Text as T +import GHC.Generics (Generic) +import Data.List +import Text.URI (URI) +import qualified Text.URI as URI + +data NixpkgsSource = NIX_PATH -- ^ Inherit the @NIX_PATH@ from the environment + | NixpkgsTarball URI -- ^ The 'URI' pointing to a nixpkgs tarball + deriving Generic + + +data NixConfig = + NixShellConfig { + environment :: Environment, -- ^ Specification of the nix environment + nixpkgsSource :: NixpkgsSource, -- ^ Which version of nixpkgs to use + command :: T.Text, -- ^ The command to run in the environment + args :: [ParamField], -- ^ Arguments to pass to the command + env :: [(T.Text, Param)], -- ^ Environmental variables which are set in the environment + stdout :: OutputCapture + } + +data Environment = ShellFile (Content File) -- ^ Path to a shell.nix file + | PackageList [T.Text] -- ^ A list of packages that + -- will be passed by @-p@. + deriving Generic + +instance ContentHashable IO Environment where + +instance ContentHashable IO NixpkgsSource where + contentHashUpdate ctx NIX_PATH = contentHashUpdate_fingerprint ctx NIX_PATH + contentHashUpdate ctx (NixpkgsTarball s) = contentHashUpdate ctx (URI.render s) + +nixpkgsSourceToParam :: NixpkgsSource -> Param +nixpkgsSourceToParam NIX_PATH = envParam "NIX_PATH" +nixpkgsSourceToParam (NixpkgsTarball uri) = textParam ("nixpkgs=" <> URI.render uri) + +toExternal :: NixConfig -> ExternalTask +toExternal NixShellConfig{..} = ExternalTask + { _etCommand = "nix-shell" + , _etParams = + [ "--run" + , Param [ParamCmd (Param (intersperse (ParamText " ") (ParamText command : args)))] + ] ++ packageSpec environment + , _etEnv = E.EnvExplicit $ ("NIX_PATH", nixpkgsSourceToParam nixpkgsSource ) : env + , _etWriteToStdOut = stdout + } + where + packageSpec :: Environment -> [Param] + packageSpec (ShellFile ip) = [contentParam ip] + packageSpec (PackageList ps) = [textParam ("-p " <> p) | p <- ps] + + +-- | Constructor a flow from a @NixConfig@ +nix :: (ContentHashable IO a, ArrowFlow eff ex arr) => (a -> NixConfig) + -> arr a CS.Item +nix f = external $ toExternal . f diff --git a/tests/Test.hs b/tests/Test.hs new file mode 100644 --- /dev/null +++ b/tests/Test.hs @@ -0,0 +1,10 @@ +import qualified TestFlows +import Test.Tasty + +main :: IO () +main = defaultMain tests + +tests :: TestTree +tests = testGroup "Unit Tests" + [ TestFlows.tests + ] diff --git a/tests/TestFlows.hs b/tests/TestFlows.hs new file mode 100644 --- /dev/null +++ b/tests/TestFlows.hs @@ -0,0 +1,93 @@ +{-# LANGUAGE Arrows #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} + +module TestFlows where + +import Control.Arrow +import Control.Concurrent.Async (withAsync) +import Control.Exception.Safe hiding (catch) +import Control.Funflow +import Control.Funflow.ContentHashable +import qualified Control.Funflow.ContentStore as CS +import Control.Funflow.External.Coordinator.Memory +import Control.Funflow.External.Executor (executeLoop) +import Path +import Path.IO +import Test.Tasty +import Test.Tasty.HUnit +import Control.Funflow.External.Nix +import Text.URI.QQ + +data FlowAssertion where + FlowAssertion :: (Eq b, Show b) + => String -- test name + -> a -- input + -> SimpleFlow a b -- the flow to test + -> Maybe b --expected output - Nothing for expected failure + -> IO () -- test setup action + -> FlowAssertion + +mkError :: String -> SomeException +mkError = toException . userError + +nixConfig :: (NixpkgsSource, Environment) -> NixConfig +nixConfig (nps, senv) = + NixShellConfig { + environment = senv + , command = "jq" + , args = [ParamText "--version"] + , env = [] + , stdout = StdOutCapture + , nixpkgsSource = nps + } + +-- | Test that we can merge directories within the content store. +jqVersion :: SimpleFlow NixpkgsSource String +jqVersion = proc np -> do + cwd <- stepIO (const getCurrentDir) -< () + shellScript <- copyFileToStore + -< (FileContent (cwd [relfile|data/shell.nix|]),[relfile|data/shell.nix|]) + readString_ <<< nix nixConfig -< (np, ShellFile shellScript) + +jqVersionPkg :: SimpleFlow NixpkgsSource String +jqVersionPkg = readString_ <<< nix (\np -> nixConfig (np, PackageList ["jq"])) + +tarballSource :: NixpkgsSource +tarballSource = NixpkgsTarball [uri|https://github.com/NixOS/nixpkgs/archive/a19357241973538212b5cb435dde84ad25cbe337.tar.gz|] + + +flowAssertions :: [FlowAssertion] +flowAssertions = + [ + FlowAssertion "shell 1" NIX_PATH jqVersion (Just "jq-1.6\n") (return ()) + , FlowAssertion "shell 2" NIX_PATH jqVersionPkg (Just "jq-1.6\n") (return ()) + + , FlowAssertion "shell tarball 1" tarballSource jqVersion (Just "jq-1.5\n") (return ()) + , FlowAssertion "shell tarball 2" tarballSource jqVersionPkg (Just "jq-1.5\n") (return ()) + ] + +testFlowAssertion :: FlowAssertion -> TestTree +testFlowAssertion (FlowAssertion nm x flw expect before) = + testCase nm $ + withSystemTempDir "test_output_" $ \storeDir -> + CS.withStore storeDir $ \store -> do + hook <- createMemoryCoordinator + before + res <- withAsync (executeLoop MemoryCoordinator hook store) $ \_ -> + runSimpleFlow MemoryCoordinator hook store flw x + assertFlowResult expect res + +assertFlowResult :: (Eq a, Show ex, Show a) => Maybe a -> Either ex a -> Assertion +assertFlowResult expect res = + case (expect, res) of + (Nothing, Left _) -> return () + (Just xr, Right y) -> assertEqual "flow results" xr y + (Nothing, Right y) -> assertFailure $ "expected flow failure, got success" ++ show y + (Just xr, Left err) -> assertFailure $ "expected success "++ show xr++", got error" ++ show err + +tests :: TestTree +tests = testGroup "Flow Assertions" $ map testFlowAssertion flowAssertions