From b9488b7f49aed8cb989f8720427c807d5b060d45 Mon Sep 17 00:00:00 2001 From: Robert Hensing Date: Fri, 27 Sep 2019 21:01:57 +0200 Subject: [PATCH] Make some commands work --- arion-compose.cabal | 3 + nix/overlay.nix | 1 + src/haskell/exe/Main.hs | 43 +++++++---- src/haskell/lib/Arion/DockerCompose.hs | 51 ++++++++++++++ src/haskell/lib/Arion/Nix.hs | 98 ++++++++++++++++++++++---- 5 files changed, 168 insertions(+), 28 deletions(-) create mode 100644 src/haskell/lib/Arion/DockerCompose.hs diff --git a/arion-compose.cabal b/arion-compose.cabal index 149839e..d413515 100644 --- a/arion-compose.cabal +++ b/arion-compose.cabal @@ -30,8 +30,10 @@ common deps , aeson-pretty , async , bytestring + , directory , process , process-extras + , temporary , text , protolude @@ -43,6 +45,7 @@ library import: deps exposed-modules: Arion.Nix Arion.Aeson + Arion.DockerCompose other-modules: Paths_arion_compose -- other-extensions: hs-source-dirs: src/haskell/lib diff --git a/nix/overlay.nix b/nix/overlay.nix index 0915ceb..3105187 100644 --- a/nix/overlay.nix +++ b/nix/overlay.nix @@ -28,6 +28,7 @@ in buildInputs = [ haskellPkgs.cabal-install haskellPkgs.ghcid + super.docker-compose ]; }; }; diff --git a/src/haskell/exe/Main.hs b/src/haskell/exe/Main.hs index c625bc3..b5910d0 100644 --- a/src/haskell/exe/Main.hs +++ b/src/haskell/exe/Main.hs @@ -7,6 +7,7 @@ import Protolude hiding (Down) import Arion.Nix import Arion.Aeson +import qualified Arion.DockerCompose as DockerCompose import Options.Applicative import Control.Applicative @@ -131,29 +132,43 @@ commandDC run cmdStr help = -------------------------------------------------------------------------------- runDC :: Text -> DockerComposeArgs -> CommonOptions -> IO () -runDC cmd (DockerComposeArgs args) opts = - panic $ "TODO: docker-compose " <> cmd <> " " <> T.unwords args +runDC cmd (DockerComposeArgs args) opts = do + DockerCompose.run DockerCompose.Args + { files = [] + , otherArgs = [cmd] ++ args + } runBuildAndDC :: Text -> DockerComposeArgs -> CommonOptions -> IO () runBuildAndDC cmd dopts opts = do - T.putStrLn "TODO: build" - runDC cmd dopts opts + ea <- defaultEvaluationArgs opts + Arion.Nix.withBuiltComposition ea $ \path -> + DockerCompose.run DockerCompose.Args + { files = [path] + , otherArgs = [cmd] ++ unDockerComposeArgs dopts + } runEvalAndDC :: Text -> DockerComposeArgs -> CommonOptions -> IO () runEvalAndDC cmd dopts opts = do - T.putStrLn "TODO: eval" - runDC cmd dopts opts + ea <- defaultEvaluationArgs opts + Arion.Nix.withEvaluatedComposition ea $ \path -> + DockerCompose.run DockerCompose.Args + { files = [path] + , otherArgs = [cmd] ++ unDockerComposeArgs dopts + } + +defaultEvaluationArgs :: CommonOptions -> IO EvaluationArgs +defaultEvaluationArgs co = pure EvaluationArgs + { evalUid = 0 -- TODO + , evalModules = files co + , evalPkgs = pkgs co + , evalWorkDir = Nothing + , evalMode = ReadWrite + , evalUserArgs = nixArgs co + } runCat :: CommonOptions -> IO () runCat co = do - v <- Arion.Nix.evaluateComposition EvaluationArgs - { evalUid = 0 -- TODO - , evalModules = files co - , evalPkgs = pkgs co - , evalWorkDir = Nothing - , evalMode = ReadWrite - , evalUserArgs = nixArgs co - } + v <- Arion.Nix.evaluateComposition =<< defaultEvaluationArgs co T.hPutStrLn stdout (pretty v) runRepl :: CommonOptions -> IO () diff --git a/src/haskell/lib/Arion/DockerCompose.hs b/src/haskell/lib/Arion/DockerCompose.hs new file mode 100644 index 0000000..804f95a --- /dev/null +++ b/src/haskell/lib/Arion/DockerCompose.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE OverloadedStrings #-} +module Arion.DockerCompose where + +import Prelude ( ) +import Protolude +import Arion.Aeson ( pretty ) +import Data.Aeson +import qualified Data.String +import System.Process +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BL +import qualified System.Process.ByteString.Lazy + as PBL +import Paths_arion_compose +import Control.Applicative + +import qualified Data.Text as T +import qualified Data.Text.IO as T + +import qualified Data.List.NonEmpty as NE +import Data.List.NonEmpty ( NonEmpty(..) ) + +import Control.Arrow ( (>>>) ) +import System.IO.Temp ( withTempFile ) +import System.IO ( hClose ) + +data Args = Args + { files :: [FilePath] + , otherArgs :: [Text] + } + +run :: Args -> IO () +run args = do + let fileArgs = files args >>= \f -> ["--file", f] + allArgs = fileArgs ++ map toS (otherArgs args) + + procSpec = proc "docker-compose" allArgs + + -- hPutStrLn stderr ("Running docker-compose with " <> show allArgs :: Text) + + withCreateProcess procSpec $ \_in _out _err procHandle -> do + + -- Wait for process exit and 'err' printout + exitCode <- waitForProcess procHandle + + case exitCode of + ExitSuccess -> pass + ExitFailure 1 -> exitFailure + e@ExitFailure {} -> do + throwIO $ FatalError $ "docker-compose failed with " <> show exitCode + exitWith e diff --git a/src/haskell/lib/Arion/Nix.hs b/src/haskell/lib/Arion/Nix.hs index 609f38f..dd06692 100644 --- a/src/haskell/lib/Arion/Nix.hs +++ b/src/haskell/lib/Arion/Nix.hs @@ -1,10 +1,18 @@ {-# LANGUAGE OverloadedStrings #-} -module Arion.Nix where +module Arion.Nix + ( evaluateComposition + , withEvaluatedComposition + , withBuiltComposition + , EvaluationArgs(..) + , EvaluationMode(..) + ) where import Prelude ( ) import Protolude +import Arion.Aeson ( pretty ) import Data.Aeson import qualified Data.String +import qualified System.Directory as Directory import System.Process import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BL @@ -20,6 +28,8 @@ import qualified Data.List.NonEmpty as NE import Data.List.NonEmpty ( NonEmpty(..) ) import Control.Arrow ( (>>>) ) +import System.IO.Temp ( withTempFile ) +import System.IO ( hClose ) data EvaluationMode = ReadWrite | ReadOnly @@ -35,7 +45,7 @@ data EvaluationArgs = EvaluationArgs evaluateComposition :: EvaluationArgs -> IO Value evaluateComposition ea = do - evalComposition <- getDataFileName "nix/eval-composition.nix" + evalComposition <- getEvalCompositionFile let commandArgs = [ "--eval" , "--strict" @@ -43,22 +53,11 @@ evaluateComposition ea = do , "--attr" , "config.build.dockerComposeYamlAttrs" ] - argArgs = - [ "--argstr" - , "uid" - , show $ evalUid ea - , "--arg" - , "modules" - , modulesNixExpr $ evalModules ea - , "--arg" - , "pkgs" - , toS $ evalPkgs ea - ] args = [ evalComposition ] ++ commandArgs ++ modeArguments (evalMode ea) - ++ argArgs + ++ argArgs ea ++ map toS (evalUserArgs ea) stdin = mempty procSpec = (proc "nix-instantiate" args) { cwd = evalWorkDir ea } @@ -83,6 +82,77 @@ evaluateComposition ea = do Right r -> pure r Left e -> throwIO $ FatalError "Couldn't parse nix-instantiate output" +-- | Run with docker-compose.yaml tmpfile +withEvaluatedComposition :: EvaluationArgs -> (FilePath -> IO r) -> IO r +withEvaluatedComposition ea f = do + v <- evaluateComposition ea + withTempFile "." ".tmp-arion-docker-compose.yaml" $ \path handle -> do + T.hPutStrLn handle (pretty v) + hClose handle + f path + + +buildComposition :: FilePath -> EvaluationArgs -> IO () +buildComposition outLink ea = do + evalComposition <- getEvalCompositionFile + let commandArgs = + [ "--attr" + , "config.build.dockerComposeYaml" + , "--out-link" + , outLink + ] + args = + [ evalComposition ] + ++ commandArgs + ++ argArgs ea + ++ map toS (evalUserArgs ea) + stdin = mempty + procSpec = (proc "nix-build" args) { cwd = evalWorkDir ea } + + -- TODO: lazy IO is tricky. Let's use conduit/pipes instead? + (exitCode, out, err) <- PBL.readCreateProcessWithExitCode procSpec stdin + + -- Stream 'err' + errDone <- async (BL.hPutStr stderr err) + + -- Force 'out' + -- TODO: use it? + _v <- Protolude.evaluate out + + -- Wait for process exit and 'err' printout + wait errDone + + case exitCode of + ExitSuccess -> pass + ExitFailure e -> throwIO $ FatalError "Build failed" -- TODO: don't print this exception in main + +-- | Do something with a docker-compose.yaml. +withBuiltComposition :: EvaluationArgs -> (FilePath -> IO r) -> IO r +withBuiltComposition ea f = do + withTempFile "." ".tmp-arion-docker-compose.yaml" $ \path handle -> do + hClose handle + -- Known problem: kills atomicity of withTempFile; won't fix because we should manage gc roots, + -- impl of which will probably avoid this "problem". It seems unlikely to cause issues. + Directory.removeFile path + buildComposition path ea + f path + +argArgs :: EvaluationArgs -> [[Char]] +argArgs ea = + [ "--argstr" + , "uid" + , show $ evalUid ea + , "--arg" + , "modules" + , modulesNixExpr $ evalModules ea + , "--arg" + , "pkgs" + , toS $ evalPkgs ea + ] + +getEvalCompositionFile :: IO FilePath +getEvalCompositionFile = getDataFileName "nix/eval-composition.nix" + modeArguments :: EvaluationMode -> [[Char]] modeArguments ReadWrite = [ "--read-write-mode" ] modeArguments ReadOnly = [ "--readonly-mode" ]