From f0a22a12fcf4448a69e220e64b12eb1645edf80d Mon Sep 17 00:00:00 2001 From: Herwig Hochleitner Date: Mon, 4 Apr 2016 23:55:06 +0200 Subject: [PATCH 1/8] Show errors from executing processes --- src/Util.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/Util.hs b/src/Util.hs index c28586d..64324b6 100644 --- a/src/Util.hs +++ b/src/Util.hs @@ -55,10 +55,9 @@ runInteractiveProcess cmd args cwd env withOutput getOutput = Concurrently (withOutput out) getErrors = Concurrently (S.fold (<>) T.empty =<< S.decodeUtf8 err) wait = Concurrently (S.waitForProcess pid) - (result, errorMessage, exit) <- runConcurrently - ((,,) <$> getOutput <*> getErrors <*> wait) + (errorMessage, exit) <- runConcurrently ((,) <$> getErrors <*> wait) case exit of - ExitSuccess -> pure result + ExitSuccess -> runConcurrently getOutput ExitFailure code -> throwIO (Died code errorMessage) showExceptions :: IO b -> IO (Maybe b) From 2b049372178b000dd5655d87c0bb3a22b7ec5885 Mon Sep 17 00:00:00 2001 From: Herwig Hochleitner Date: Tue, 5 Apr 2016 02:30:04 +0200 Subject: [PATCH 2/8] Pass ca authority by env variable --- src/Distribution/Nix/Fetch.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Distribution/Nix/Fetch.hs b/src/Distribution/Nix/Fetch.hs index e13aa66..95e349b 100644 --- a/src/Distribution/Nix/Fetch.hs +++ b/src/Distribution/Nix/Fetch.hs @@ -113,7 +113,8 @@ prefetchHelper :: String -> [String] prefetchHelper fetcher args go = mapException FetchError helper where helper = do - env <- addToEnv "PRINT_PATH" "1" + env <- ( addToEnv "PRINT_PATH" "1" + >> addToEnv "SSL_CERT_FILE" "/etc/ssl/certs/ca-certificates.crt") runInteractiveProcess fetcher args Nothing (Just env) go addToEnv :: MonadIO m => String -> String -> m [(String, String)] From b27711262f0c4e7ffd1ccd92847ecf563e3646b1 Mon Sep 17 00:00:00 2001 From: Herwig Hochleitner Date: Tue, 5 Apr 2016 05:10:04 +0200 Subject: [PATCH 3/8] Always consume input from running processes --- src/Util.hs | 33 +++++++++++++++++++++++++++------ 1 file changed, 27 insertions(+), 6 deletions(-) diff --git a/src/Util.hs b/src/Util.hs index 64324b6..f9dcd32 100644 --- a/src/Util.hs +++ b/src/Util.hs @@ -33,6 +33,7 @@ import Data.Typeable (Typeable) import System.Exit (ExitCode(..)) import System.IO.Streams (InputStream) import qualified System.IO.Streams as S +import Debug.Trace data Died = Died Int Text deriving (Show, Typeable) @@ -44,6 +45,14 @@ data ProcessFailed = ProcessFailed String [String] SomeException instance Exception ProcessFailed +data ProcessingFailed = ProcessingFailed Text Text SomeException + deriving (Show, Typeable) + +instance Exception ProcessingFailed + +slurp :: InputStream ByteString -> IO Text +slurp stream = S.fold (<>) T.empty =<< S.decodeUtf8 stream + runInteractiveProcess :: String -> [String] -> Maybe FilePath -> Maybe [(String, String)] -> (InputStream ByteString -> IO a) @@ -52,13 +61,25 @@ runInteractiveProcess cmd args cwd env withOutput = mapExceptionIO (ProcessFailed cmd args) $ do (_, out, err, pid) <- S.runInteractiveProcess cmd args cwd env let - getOutput = Concurrently (withOutput out) - getErrors = Concurrently (S.fold (<>) T.empty =<< S.decodeUtf8 err) + getOutput = + Concurrently + (catch + (fmap Right $ withOutput out) + (\e -> (fmap (Left . ((,) e)) (slurp out)))) + ---- Maybe catch exceptions that might occur by just slurping the input stream + ---- couldn't get this to type (Ambigous exception type) + -- (\e -> catch + -- (fmap (Left . ((,) e)) (slurp out)) + -- -- (Left (e, slurp out)) + -- (\ei -> pure $ Left (e, T.pack $ "INPUT ERROR " ++ show ei)))) + getErrors = Concurrently $ slurp err wait = Concurrently (S.waitForProcess pid) - (errorMessage, exit) <- runConcurrently ((,) <$> getErrors <*> wait) - case exit of - ExitSuccess -> runConcurrently getOutput - ExitFailure code -> throwIO (Died code errorMessage) + (output, errorMessage, exit) <- runConcurrently ((,,) <$> getOutput <*> getErrors <*> wait) + case (exit, output) of + (ExitSuccess, Right v) -> pure v + (ExitSuccess, Left (ex, leftover)) -> throwIO $ ProcessingFailed leftover errorMessage ex + (ExitFailure code, Left info) -> throwIO $ trace (show info) $ Died code errorMessage + (ExitFailure code, Right v) -> throwIO $ Died code "WTF successful parse of error'd program" showExceptions :: IO b -> IO (Maybe b) showExceptions go = catch (Just <$> go) handler From b57e5ae19ed282ccfb1db92587fe3fc5f64f9fa3 Mon Sep 17 00:00:00 2001 From: Herwig Hochleitner Date: Wed, 13 Apr 2016 15:54:33 +0200 Subject: [PATCH 4/8] remove version overrides for newer hackage see https://github.com/NixOS/nixpkgs/issues/14643 --- shell.nix | 3 --- 1 file changed, 3 deletions(-) diff --git a/shell.nix b/shell.nix index 4614f3e..da93e7e 100644 --- a/shell.nix +++ b/shell.nix @@ -11,8 +11,6 @@ let enableLibraryProfiling = profiling; }); - aeson = self.aeson_0_11_1_4; - bifunctors = lib.dontHaddock self.bifunctors_5_2_1; comonad = lib.doJailbreak (lib.dontCheck super.comonad); distributive = lib.dontCheck super.distributive; fail = lib.dontHaddock super.fail; @@ -22,7 +20,6 @@ let parsers = lib.doJailbreak super.parsers; reducers = lib.doJailbreak super.reducers; semigroupoids = lib.dontCheck super.semigroupoids; - transformers-compat = self.transformers-compat_0_5_1_4; trifecta = lib.doJailbreak (lib.dontCheck super.trifecta); unordered-containers = lib.doJailbreak super.unordered-containers; }; From c0c0a497788334ead3084c1323830f554398b8db Mon Sep 17 00:00:00 2001 From: Herwig Hochleitner Date: Wed, 13 Apr 2016 16:19:43 +0200 Subject: [PATCH 5/8] enable multiple env additions --- src/Distribution/Nix/Fetch.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Distribution/Nix/Fetch.hs b/src/Distribution/Nix/Fetch.hs index 95e349b..c2c4280 100644 --- a/src/Distribution/Nix/Fetch.hs +++ b/src/Distribution/Nix/Fetch.hs @@ -113,12 +113,12 @@ prefetchHelper :: String -> [String] prefetchHelper fetcher args go = mapException FetchError helper where helper = do - env <- ( addToEnv "PRINT_PATH" "1" - >> addToEnv "SSL_CERT_FILE" "/etc/ssl/certs/ca-certificates.crt") + env <- addToEnv [("PRINT_PATH", "1"), + ("SSL_CERT_FILE", "/etc/ssl/certs/ca-certificates.crt")] runInteractiveProcess fetcher args Nothing (Just env) go -addToEnv :: MonadIO m => String -> String -> m [(String, String)] -addToEnv var val = liftIO $ M.toList . M.insert var val . M.fromList <$> getEnvironment +addToEnv :: [(String, String)] -> IO [(String, String)] +addToEnv env = (++ env) <$> getEnvironment data BadPrefetchOutput = BadPrefetchOutput deriving (Show, Typeable) From 2c3462c60e7b2a566c6b72d4d4f6a6b5549c1928 Mon Sep 17 00:00:00 2001 From: Herwig Hochleitner Date: Wed, 13 Apr 2016 18:09:23 +0200 Subject: [PATCH 6/8] export SSL_CERT_FILE from scripts --- melpa-packages.sh | 5 ++++- melpa-stable-packages.sh | 3 +++ 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/melpa-packages.sh b/melpa-packages.sh index 9790dc9..851fb67 100755 --- a/melpa-packages.sh +++ b/melpa-packages.sh @@ -1,6 +1,9 @@ #!/usr/bin/env nix-shell -#!nix-shell --pure -i bash -A env +#!nix-shell -i bash -A env # usage: ./melpa-packages.sh --melpa PATH_TO_MELPA_CLONE +## env var for curl +export SSL_CERT_FILE=/etc/ssl/certs/ca-certificates.crt + cabal run melpa2nix -- --work /tmp/melpa2nix "$@" diff --git a/melpa-stable-packages.sh b/melpa-stable-packages.sh index 113262f..b4ce09e 100755 --- a/melpa-stable-packages.sh +++ b/melpa-stable-packages.sh @@ -3,4 +3,7 @@ # usage: ./melpa-packages.sh --melpa PATH_TO_MELPA_CLONE +## env var for curl +export SSL_CERT_FILE=/etc/ssl/certs/ca-certificates.crt + cabal run melpa2nix -- --stable --work /tmp/melpa2nix "$@" From 68a5aea0878c2bef532bb33939ea2dd93a27be41 Mon Sep 17 00:00:00 2001 From: Herwig Hochleitner Date: Wed, 13 Apr 2016 19:17:21 +0200 Subject: [PATCH 7/8] Fix nix-prefetch-hg output parse --- src/Distribution/Nix/Fetch.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Distribution/Nix/Fetch.hs b/src/Distribution/Nix/Fetch.hs index c2c4280..9c069a4 100644 --- a/src/Distribution/Nix/Fetch.hs +++ b/src/Distribution/Nix/Fetch.hs @@ -162,7 +162,7 @@ prefetch _ fetch@(Hg {..}) = do prefetchHelper "nix-prefetch-hg" args $ \out -> do hashes <- liftIO (S.lines out >>= S.decodeUtf8 >>= S.toList) case hashes of - (_:hash:path:_) -> pure (T.unpack path, fetch { sha256 = Just hash }) + (hash:path:_) -> pure (T.unpack path, fetch { sha256 = Just hash }) _ -> throwIO BadPrefetchOutput prefetch name fetch@(CVS {..}) = do From c50ac1541373b1190a792e59a5819faeec232d5d Mon Sep 17 00:00:00 2001 From: Herwig Hochleitner Date: Wed, 13 Apr 2016 20:30:08 +0200 Subject: [PATCH 8/8] fix nix-prefetch-git output parser --- src/Distribution/Nix/Fetch.hs | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/src/Distribution/Nix/Fetch.hs b/src/Distribution/Nix/Fetch.hs index 9c069a4..4818abd 100644 --- a/src/Distribution/Nix/Fetch.hs +++ b/src/Distribution/Nix/Fetch.hs @@ -36,6 +36,10 @@ import Data.Typeable (Typeable) import Nix.Expr import System.Environment (getEnvironment) import qualified System.IO.Streams as S +import qualified System.IO.Streams.Attoparsec as S +import Data.Aeson ( parseJSON, Value, Object, (.:!), withObject ) +import Data.Aeson.Parser ( json' ) +import Data.Aeson.Types ( parseEither ) import Util (runInteractiveProcess) @@ -143,10 +147,13 @@ prefetch _ fetch@(Git {..}) = do branch = do name <- branchName pure ["--branch-name", T.unpack name] + jsonp = withObject "need an object" (\o -> o .:! "sha256") prefetchHelper "nix-prefetch-git" args $ \out -> do - hashes <- liftIO (S.lines out >>= S.decodeUtf8 >>= S.toList) - case hashes of - (_:_:hash:path:_) -> pure (T.unpack path, fetch { sha256 = Just hash }) + sha256 <- liftIO $ parseEither jsonp <$> S.parseFromStream json' out + pathes <- liftIO (S.lines out >>= S.decodeUtf8 >>= S.toList) + case (sha256, pathes) of + (Right sha,(_:path:_)) -> pure (T.unpack path, + fetch { sha256 = sha }) _ -> throwIO BadPrefetchOutput prefetch _ fetch@(Bzr {..}) = do