diff --git a/ChangeLog.md b/ChangeLog.md index 87e64958..1dddb87e 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,11 @@ +## 0.6.1 + +* Switch to V2 upload by default + +## 0.6.0 + +* Upload bundle V2 stuff + ## 0.5.2 * Upload LTS to Hackage with the name LTSHaskell diff --git a/Dockerfile b/Dockerfile index a83c42bc..c3956908 100644 --- a/Dockerfile +++ b/Dockerfile @@ -14,9 +14,9 @@ ADD debian-bootstrap.sh /tmp/debian-bootstrap.sh RUN DEBIAN_FRONTEND=noninteractive bash /tmp/debian-bootstrap.sh RUN rm /tmp/debian-bootstrap.sh -RUN DEBIAN_FRONTEND=noninteractive apt-get install -y cabal-install-1.20 ghc-7.8.4 +RUN DEBIAN_FRONTEND=noninteractive apt-get install -y cabal-install-1.20 ghc-7.8.4 alex-3.1.3 happy-1.19.4 -ENV PATH /home/stackage/.cabal/bin:/usr/local/sbin:/usr/local/bin:/opt/ghc/7.8.4/bin:/opt/cabal/1.20/bin:/usr/sbin:/usr/bin:/sbin:/bin +ENV PATH /home/stackage/.cabal/bin:/usr/local/sbin:/usr/local/bin:/opt/ghc/7.8.4/bin:/opt/cabal/1.20/bin:/opt/alex/3.1.3/bin:/opt/happy/1.19.4/bin:/usr/sbin:/usr/bin:/sbin:/bin RUN cabal update ADD . /tmp/stackage diff --git a/Stackage/BuildConstraints.hs b/Stackage/BuildConstraints.hs index e7aae355..c4ce1ceb 100644 --- a/Stackage/BuildConstraints.hs +++ b/Stackage/BuildConstraints.hs @@ -120,7 +120,7 @@ instance FromJSON PackageConstraints where pcBuildBenchmarks <- o .: "build-benchmarks" pcFlagOverrides <- Map.mapKeysWith const mkFlagName <$> o .: "flags" pcMaintainer <- o .:? "maintainer" - pcEnableLibProfile <- fmap (fromMaybe False) (o .:? "library-profiling") + pcEnableLibProfile <- fmap (fromMaybe True) (o .:? "library-profiling") return PackageConstraints {..} -- | The proposed plan from the requirements provided by contributors. diff --git a/Stackage/CompleteBuild.hs b/Stackage/CompleteBuild.hs index cf74eef2..fb1cdde5 100644 --- a/Stackage/CompleteBuild.hs +++ b/Stackage/CompleteBuild.hs @@ -8,6 +8,7 @@ module Stackage.CompleteBuild , completeBuild , justCheck , justUploadNightly + , getStackageAuthToken ) where import Control.Concurrent (threadDelay) @@ -33,10 +34,14 @@ import System.IO (BufferMode (LineBuffering), hSetBuffering) -- | Flags passed in from the command line. data BuildFlags = BuildFlags { bfEnableTests :: !Bool + , bfEnableHaddock :: !Bool , bfDoUpload :: !Bool , bfEnableLibProfile :: !Bool + , bfEnableExecDyn :: !Bool , bfVerbose :: !Bool , bfSkipCheck :: !Bool + , bfUploadV1 :: !Bool + , bfServer :: !StackageServer } deriving (Show) data BuildType = Nightly | LTS BumpType @@ -55,6 +60,8 @@ data Settings = Settings , setArgs :: Text -> UploadBundle -> UploadBundle , postBuild :: IO () , distroName :: Text -- ^ distro name on Hackage + , snapshotType :: SnapshotType + , bundleDest :: FilePath } nightlyPlanFile :: Text -- ^ day @@ -66,7 +73,7 @@ nightlySettings :: Text -- ^ day -> Settings nightlySettings day plan' = Settings { planFile = nightlyPlanFile day - , buildDir = fpFromText $ "builds/stackage-nightly-" ++ day + , buildDir = fpFromText $ "builds/nightly" , logDir = fpFromText $ "logs/stackage-nightly-" ++ day , title = \ghcVer -> concat [ "Stackage Nightly " @@ -79,6 +86,8 @@ nightlySettings day plan' = Settings , plan = plan' , postBuild = return () , distroName = "Stackage" + , snapshotType = STNightly + , bundleDest = fpFromText $ "stackage-nightly-" ++ day ++ ".bundle" } where slug' = "nightly-" ++ day @@ -119,7 +128,7 @@ getSettings man (LTS bumpType) = do return Settings { planFile = newfile - , buildDir = fpFromText $ "builds/stackage-lts-" ++ tshow new + , buildDir = fpFromText $ "builds/lts" , logDir = fpFromText $ "logs/stackage-lts-" ++ tshow new , title = \ghcVer -> concat [ "LTS Haskell " @@ -140,6 +149,10 @@ getSettings man (LTS bumpType) = do putStrLn "Pushing to Git repository" git ["push"] , distroName = "LTSHaskell" + , snapshotType = + case new of + LTSVer x y -> STLTS x y + , bundleDest = fpFromText $ "stackage-lts-" ++ tshow new ++ ".bundle" } data LTSVer = LTSVer !Int !Int @@ -203,7 +216,9 @@ getPerformBuild buildFlags Settings {..} = PerformBuild , pbJobs = 8 , pbGlobalInstall = False , pbEnableTests = bfEnableTests buildFlags + , pbEnableHaddock = bfEnableHaddock buildFlags , pbEnableLibProfiling = bfEnableLibProfile buildFlags + , pbEnableExecDyn = bfEnableExecDyn buildFlags , pbVerbose = bfVerbose buildFlags , pbAllowNewer = bfSkipCheck buildFlags } @@ -227,10 +242,23 @@ completeBuild buildType buildFlags = withManager tlsManagerSettings $ \man -> do checkBuildPlan plan putStrLn "Performing build" - performBuild (getPerformBuild buildFlags settings) >>= mapM_ putStrLn + let pb = getPerformBuild buildFlags settings + performBuild pb >>= mapM_ putStrLn + + putStrLn $ "Creating bundle (v2) at: " ++ fpToText bundleDest + createBundleV2 CreateBundleV2 + { cb2Plan = plan + , cb2Type = snapshotType + , cb2DocsDir = pbDocDir pb + , cb2Dest = bundleDest + } when (bfDoUpload buildFlags) $ - finallyUpload settings man + finallyUpload + (not $ bfUploadV1 buildFlags) + (bfServer buildFlags) + settings + man justUploadNightly :: Text -- ^ nightly date @@ -238,41 +266,64 @@ justUploadNightly justUploadNightly day = do plan <- decodeFileEither (fpToString $ nightlyPlanFile day) >>= either throwM return - withManager tlsManagerSettings $ finallyUpload $ nightlySettings day plan + withManager tlsManagerSettings $ finallyUpload False def $ nightlySettings day plan + +getStackageAuthToken :: IO Text +getStackageAuthToken = do + mtoken <- lookupEnv "STACKAGE_AUTH_TOKEN" + case mtoken of + Nothing -> decodeUtf8 <$> readFile "/auth-token" + Just token -> return $ pack token -- | The final part of the complete build process: uploading a bundle, -- docs and a distro to hackage. -finallyUpload :: Settings -> Manager -> IO () -finallyUpload settings@Settings{..} man = do +finallyUpload :: Bool -- ^ use v2 upload + -> StackageServer + -> Settings -> Manager -> IO () +finallyUpload useV2 server settings@Settings{..} man = do putStrLn "Uploading bundle to Stackage Server" - mtoken <- lookupEnv "STACKAGE_AUTH_TOKEN" - token <- - case mtoken of - Nothing -> decodeUtf8 <$> readFile "/auth-token" - Just token -> return $ pack token + token <- getStackageAuthToken - now <- epochTime - let ghcVer = display $ siGhcVersion $ bpSystemInfo plan - (ident, mloc) <- flip uploadBundle man $ setArgs ghcVer def - { ubContents = serverBundle now (title ghcVer) slug plan - , ubAuthToken = token - } - putStrLn $ "New ident: " ++ unSnapshotIdent ident - forM_ mloc $ \loc -> - putStrLn $ "Track progress at: " ++ loc + if useV2 + then do + res <- flip uploadBundleV2 man UploadBundleV2 + { ub2Server = server + , ub2AuthToken = token + , ub2Bundle = bundleDest + } + putStrLn $ "New snapshot available at: " ++ res + else do + now <- epochTime + let ghcVer = display $ siGhcVersion $ bpSystemInfo plan + (ident, mloc) <- flip uploadBundle man $ setArgs ghcVer def + { ubContents = serverBundle now (title ghcVer) slug plan + , ubAuthToken = token + } + putStrLn $ "New ident: " ++ unSnapshotIdent ident + forM_ mloc $ \loc -> + putStrLn $ "Track progress at: " ++ loc + + putStrLn "Uploading docs to Stackage Server" + res1 <- tryAny $ uploadDocs UploadDocs + { udServer = def + , udAuthToken = token + , udDocs = pbDocDir pb + , udSnapshot = ident + } man + putStrLn $ "Doc upload response: " ++ tshow res1 + + putStrLn "Uploading doc map" + tryAny (uploadDocMap UploadDocMap + { udmServer = def + , udmAuthToken = token + , udmSnapshot = ident + , udmDocDir = pbDocDir pb + , udmPlan = plan + } man) >>= print postBuild `catchAny` print - putStrLn "Uploading docs to Stackage Server" - res1 <- uploadDocs UploadDocs - { udServer = def - , udAuthToken = token - , udDocs = pbDocDir pb - , udSnapshot = ident - } man - putStrLn $ "Doc upload response: " ++ tshow res1 - ecreds <- tryIO $ readFile "/hackage-creds" case map encodeUtf8 $ words $ decodeUtf8 $ either (const "") id ecreds of [username, password] -> do @@ -280,14 +331,5 @@ finallyUpload settings@Settings{..} man = do res2 <- uploadHackageDistroNamed distroName plan username password man putStrLn $ "Distro upload response: " ++ tshow res2 _ -> putStrLn "No creds found, skipping Hackage distro upload" - - putStrLn "Uploading doc map" - uploadDocMap UploadDocMap - { udmServer = def - , udmAuthToken = token - , udmSnapshot = ident - , udmDocDir = pbDocDir pb - , udmPlan = plan - } man >>= print where pb = getPerformBuild (error "finallyUpload.buildFlags") settings diff --git a/Stackage/GhcPkg.hs b/Stackage/GhcPkg.hs new file mode 100644 index 00000000..27b7f9e1 --- /dev/null +++ b/Stackage/GhcPkg.hs @@ -0,0 +1,104 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} +-- | General commands related to ghc-pkg. + +module Stackage.GhcPkg + ( setupPackageDatabase + ) where + +import Data.Conduit +import qualified Data.Conduit.List as CL +import Data.Conduit.Process +import qualified Data.Conduit.Text as CT +import Data.Maybe +import Data.Text (Text) +import qualified Data.Text as T +import Distribution.Compat.ReadP +import Distribution.Package +import Distribution.Text (parse) +import Filesystem.Path.CurrentOS (FilePath) +import qualified Filesystem.Path.CurrentOS as FP +import Data.Map (Map) +import Data.Version (Version) +import Stackage.Prelude +import Filesystem (removeTree) + +setupPackageDatabase + :: Maybe FilePath -- ^ database location, Nothing if using global DB + -> FilePath -- ^ documentation root + -> (ByteString -> IO ()) -- ^ logging + -> Map PackageName Version -- ^ packages and versions to be installed + -> (PackageIdentifier -> IO ()) -- ^ callback to be used when unregistering a package + -> IO (Set PackageName) -- ^ packages remaining in the database after cleanup +setupPackageDatabase mdb docDir log' toInstall onUnregister = do + registered1 <- getRegisteredPackages flags + forM_ registered1 $ \pi@(PackageIdentifier name version) -> + case lookup name toInstall of + Just version' | version /= version' -> unregisterPackage log' onUnregister docDir flags pi + _ -> return () + broken <- getBrokenPackages flags + forM_ broken $ unregisterPackage log' onUnregister docDir flags + foldMap (\(PackageIdentifier name _) -> singletonSet name) + <$> getRegisteredPackages flags + where + flags = ghcPkgFlags mdb + +ghcPkgFlags :: Maybe FilePath -> [String] +ghcPkgFlags mdb = + "--no-user-package-db" : + case mdb of + Nothing -> ["--global"] + Just fp -> ["--package-db=" ++ fpToString fp] + +-- | Get broken packages. +getBrokenPackages :: [String] -> IO [PackageIdentifier] +getBrokenPackages flags = do + (_,ps) <- sourceProcessWithConsumer + (proc + "ghc-pkg" + ("check" : "--simple-output" : flags)) + (CT.decodeUtf8 $= CT.lines $= CL.consume) + return (mapMaybe parsePackageIdent (T.words (T.unlines ps))) + +-- | Get available packages. +getRegisteredPackages :: [String] -> IO [PackageIdentifier] +getRegisteredPackages flags = do + (_,ps) <- sourceProcessWithConsumer + (proc + "ghc-pkg" + ("list" : "--simple-output" : flags)) + (CT.decodeUtf8 $= CT.lines $= CL.consume) + return (mapMaybe parsePackageIdent (T.words (T.unlines ps))) + +-- | Parse a package identifier: foo-1.2.3 +parsePackageIdent :: Text -> Maybe PackageIdentifier +parsePackageIdent = fmap fst . + listToMaybe . + filter (null . snd) . + readP_to_S parse . T.unpack + +-- | Unregister a package. +unregisterPackage :: (ByteString -> IO ()) -- ^ log func + -> (PackageIdentifier -> IO ()) -- ^ callback to be used when unregistering a package + -> FilePath -- ^ doc directory + -> [String] -> PackageIdentifier -> IO () +unregisterPackage log' onUnregister docDir flags ident@(PackageIdentifier name _) = do + log' $ "Unregistering " ++ encodeUtf8 (display ident) ++ "\n" + onUnregister ident + + -- Delete libraries + sourceProcessWithConsumer + (proc "ghc-pkg" ("describe" : flags ++ [unpack $ display ident])) + (CT.decodeUtf8 + $= CT.lines + $= CL.mapMaybe parseLibraryDir + $= CL.mapM_ (void . tryIO . removeTree)) + + void (readProcessWithExitCode + "ghc-pkg" + ("unregister": flags ++ ["--force", unpack $ display name]) + "") + + void $ tryIO $ removeTree $ docDir fpFromText (display ident) + where + parseLibraryDir = fmap fpFromText . stripPrefix "library-dirs: " diff --git a/Stackage/InstallBuild.hs b/Stackage/InstallBuild.hs index abe8a14e..757939a7 100644 --- a/Stackage/InstallBuild.hs +++ b/Stackage/InstallBuild.hs @@ -28,7 +28,9 @@ data InstallFlags = InstallFlags , ifJobs :: !Int , ifGlobalInstall :: !Bool , ifEnableTests :: !Bool + , ifEnableHaddock :: !Bool , ifEnableLibProfiling :: !Bool + , ifEnableExecDyn :: !Bool , ifVerbose :: !Bool , ifSkipCheck :: !Bool } deriving (Show) @@ -48,7 +50,9 @@ getPerformBuild plan InstallFlags{..} = , pbJobs = ifJobs , pbGlobalInstall = ifGlobalInstall , pbEnableTests = ifEnableTests + , pbEnableHaddock = ifEnableHaddock , pbEnableLibProfiling = ifEnableLibProfiling + , pbEnableExecDyn = ifEnableExecDyn , pbVerbose = ifVerbose , pbAllowNewer = ifSkipCheck } diff --git a/Stackage/PerformBuild.hs b/Stackage/PerformBuild.hs index b1682e4e..38bb1250 100644 --- a/Stackage/PerformBuild.hs +++ b/Stackage/PerformBuild.hs @@ -19,17 +19,18 @@ import qualified Data.Map as Map import Data.NonNull (fromNullable) import Filesystem (canonicalizePath, createTree, getWorkingDirectory, isDirectory, - removeTree, rename) + removeTree, rename, isFile, removeFile) import Filesystem.Path (parent) import qualified Filesystem.Path as F import Stackage.BuildConstraints import Stackage.BuildPlan +import Stackage.GhcPkg import Stackage.PackageDescription import Stackage.Prelude hiding (pi) import System.Directory (findExecutable) import System.Environment (getEnvironment) import System.IO (IOMode (WriteMode), - withBinaryFile) + openBinaryFile) import System.IO.Temp (withSystemTempDirectory) data BuildException = BuildException (Map PackageName BuildFailure) [Text] @@ -62,7 +63,9 @@ data PerformBuild = PerformBuild , pbGlobalInstall :: Bool -- ^ Register packages in the global database , pbEnableTests :: Bool + , pbEnableHaddock :: Bool , pbEnableLibProfiling :: Bool + , pbEnableExecDyn :: Bool , pbVerbose :: Bool , pbAllowNewer :: Bool -- ^ Pass --allow-newer to cabal configure @@ -89,7 +92,7 @@ waitForDeps toolMap packageMap activeComps bp pi action = do Nothing | isCoreExe exe -> return () -- https://github.com/jgm/zip-archive/issues/23 - -- | otherwise -> throwSTM $ ToolMissing exe + -- - | otherwise -> throwSTM $ ToolMissing exe | otherwise -> return () Just packages -> ofoldl1' (<|>) packages action @@ -133,6 +136,10 @@ pbLibDir pb = pbInstallDest pb "lib" pbDataDir pb = pbInstallDest pb "share" pbDocDir pb = pbInstallDest pb "doc" +-- | Directory keeping previous result info +pbPrevResDir :: PerformBuild -> FilePath +pbPrevResDir pb = pbInstallDest pb "prevres" + performBuild :: PerformBuild -> IO [Text] performBuild pb = do cwd <- getWorkingDirectory @@ -160,12 +167,13 @@ performBuild' pb@PerformBuild {..} = withBuildDir $ \builddir -> do $ \ClosedStream Inherited Inherited -> return () let removeTree' fp = whenM (isDirectory fp) (removeTree fp) - mapM_ removeTree' [pbInstallDest, pbLogDir] + removeTree' pbLogDir - forM_ (pbDatabase pb) $ \db -> do - createTree $ parent db - withCheckedProcess (proc "ghc-pkg" ["init", fpToString db]) - $ \ClosedStream Inherited Inherited -> return () + forM_ (pbDatabase pb) $ \db -> + unlessM (isFile $ db "package.cache") $ do + createTree $ parent db + withCheckedProcess (proc "ghc-pkg" ["init", fpToString db]) + $ \ClosedStream Inherited Inherited -> return () pbLog $ encodeUtf8 "Copying built-in Haddocks\n" copyBuiltInHaddocks (pbDocDir pb) pbLog $ encodeUtf8 "Finished copying built-in Haddocks\n" @@ -186,7 +194,15 @@ performBuild' pb@PerformBuild {..} = withBuildDir $ \builddir -> do env <- getEnvironment haddockFiles <- newTVarIO mempty - forM_ packageMap $ \pi -> void $ async $ singleBuild pb SingleBuild + registeredPackages <- setupPackageDatabase + (pbDatabase pb) + (pbDocDir pb) + pbLog + (ppVersion <$> bpPackages pbPlan) + (deletePreviousResults pb) + + forM_ packageMap $ \pi -> void $ async $ singleBuild pb registeredPackages + SingleBuild { sbSem = sem , sbErrsVar = errsVar , sbWarningsVar = warningsVar @@ -248,8 +264,10 @@ data SingleBuild = SingleBuild , sbHaddockFiles :: TVar (Map Text FilePath) -- ^ package-version, .haddock file } -singleBuild :: PerformBuild -> SingleBuild -> IO () -singleBuild pb@PerformBuild {..} SingleBuild {..} = +singleBuild :: PerformBuild + -> Set PackageName -- ^ registered packages + -> SingleBuild -> IO () +singleBuild pb@PerformBuild {..} registeredPackages SingleBuild {..} = withCounter sbActive $ handle updateErrs $ (`finally` void (atomically $ tryPutTMVar (piResult sbPackageInfo) False)) @@ -261,22 +279,25 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} = let wfd comps = waitForDeps sbToolMap sbPackageMap comps pbPlan sbPackageInfo . withTSem sbSem - wfd libComps buildLibrary + withUnpacked <- wfd libComps buildLibrary - wfd testComps runTests + wfd testComps (runTests withUnpacked) - name = display $ piName sbPackageInfo + pname = piName sbPackageInfo + pident = PackageIdentifier pname (ppVersion $ piPlan sbPackageInfo) + name = display pname namever = concat [ name , "-" , display $ ppVersion $ piPlan sbPackageInfo ] - runIn wdir outH cmd args = - withCheckedProcess cp $ \ClosedStream UseProvidedHandle UseProvidedHandle -> + runIn wdir getOutH cmd args = do + outH <- getOutH + withCheckedProcess (cp outH) $ \ClosedStream UseProvidedHandle UseProvidedHandle -> (return () :: IO ()) where - cp = (proc (unpack $ asText cmd) (map (unpack . asText) args)) + cp outH = (proc (unpack $ asText cmd) (map (unpack . asText) args)) { cwd = Just $ fpToString wdir , std_out = UseHandle outH , std_err = UseHandle outH @@ -302,8 +323,21 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} = testRunOut = pbLogDir fpFromText namever "test-run.out" wf fp inner' = do - createTree $ parent fp - withBinaryFile (fpToString fp) WriteMode inner' + ref <- newIORef Nothing + let cleanup = do + mh <- readIORef ref + forM_ mh hClose + getH = do + mh <- readIORef ref + case mh of + Just h -> return h + Nothing -> mask_ $ do + createTree $ parent fp + h <- openBinaryFile (fpToString fp) WriteMode + writeIORef ref $ Just h + return h + + inner' getH `finally` cleanup configArgs = ($ []) $ execWriter $ do when pbAllowNewer $ tell' "--allow-newer" @@ -317,6 +351,7 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} = tell' $ "--flags=" ++ flags when (pbEnableLibProfiling && pcEnableLibProfile) $ tell' "--enable-library-profiling" + when pbEnableExecDyn $ tell' "--enable-executable-dynamic" where tell' x = tell (x:) @@ -330,22 +365,40 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} = PackageConstraints {..} = ppConstraints $ piPlan sbPackageInfo - buildLibrary = wf libOut $ \outH -> do + buildLibrary = wf libOut $ \getOutH -> do let run a b = do when pbVerbose $ log' (unwords (a : b)) - runChild outH a b - log' $ "Unpacking " ++ namever - runParent outH "cabal" ["unpack", namever] + runChild getOutH a b - log' $ "Configuring " ++ namever - run "cabal" $ "configure" : configArgs + isUnpacked <- newIORef False + let withUnpacked inner = do + unlessM (readIORef isUnpacked) $ do + log' $ "Unpacking " ++ namever + runParent getOutH "cabal" ["unpack", namever] + writeIORef isUnpacked True + inner - log' $ "Building " ++ namever - run "cabal" ["build"] + isConfiged <- newIORef False + let withConfiged inner = withUnpacked $ do + unlessM (readIORef isConfiged) $ do + log' $ "Configuring " ++ namever + run "cabal" $ "configure" : configArgs + writeIORef isConfiged True + inner - log' $ "Copying/registering " ++ namever - run "cabal" ["copy"] - withMVar sbRegisterMutex $ const $ - run "cabal" ["register"] + prevBuildResult <- getPreviousResult pb Build pident + unless (prevBuildResult == PRSuccess) $ withConfiged $ do + assert (pname `notMember` registeredPackages) $ do + deletePreviousResults pb pident + + log' $ "Building " ++ namever + run "cabal" ["build"] + + log' $ "Copying/registering " ++ namever + run "cabal" ["copy"] + withMVar sbRegisterMutex $ const $ + run "cabal" ["register"] + + savePreviousResult pb Build pident True -- Even if the tests later fail, we can allow other libraries to build -- on top of our successful results @@ -355,7 +408,11 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} = -- dependency's haddocks before this finishes atomically $ putTMVar (piResult sbPackageInfo) True - when (pcHaddocks /= Don'tBuild && not (null $ sdModules $ ppDesc $ piPlan sbPackageInfo)) $ do + prevHaddockResult <- getPreviousResult pb Haddock pident + let needHaddock = pbEnableHaddock + && checkPrevResult prevHaddockResult pcHaddocks + && not (null $ sdModules $ ppDesc $ piPlan sbPackageInfo) + when needHaddock $ withConfiged $ do log' $ "Haddocks " ++ namever hfs <- readTVarIO sbHaddockFiles let hfsOpts = flip map (mapToList hfs) $ \(pkgVer, hf) -> concat @@ -389,15 +446,21 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} = $ modifyTVar sbHaddockFiles $ insertMap namever newPath + savePreviousResult pb Haddock pident $ either (const False) (const True) eres case (eres, pcHaddocks) of (Left e, ExpectSuccess) -> throwM e (Right (), ExpectFailure) -> warn $ namever ++ ": unexpected Haddock success" _ -> return () - runTests = wf testOut $ \outH -> do - let run = runChild outH + return withUnpacked - when (pbEnableTests && pcTests /= Don'tBuild) $ do + runTests withUnpacked = wf testOut $ \getOutH -> do + let run = runChild getOutH + + prevTestResult <- getPreviousResult pb Test pident + let needTest = pbEnableTests + && checkPrevResult prevTestResult pcTests + when needTest $ withUnpacked $ do log' $ "Test configure " ++ namever run "cabal" $ "configure" : "--enable-tests" : configArgs @@ -408,6 +471,7 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} = log' $ "Test run " ++ namever run "cabal" ["test", "--log=" ++ fpToText testRunOut] + savePreviousResult pb Test pident $ either (const False) (const True) eres case (eres, pcTests) of (Left e, ExpectSuccess) -> throwM e (Right (), ExpectFailure) -> warn $ namever ++ ": unexpected test success" @@ -434,16 +498,6 @@ singleBuild pb@PerformBuild {..} SingleBuild {..} = renameOrCopy :: FilePath -> FilePath -> IO () renameOrCopy src dest = rename src dest `catchIO` \_ -> copyDir src dest -copyDir :: FilePath -> FilePath -> IO () -copyDir src dest = - runResourceT $ sourceDirectoryDeep False src $$ mapM_C go - where - src' = src "" - go fp = forM_ (F.stripPrefix src' fp) $ \suffix -> do - let dest' = dest suffix - liftIO $ createTree $ parent dest' - sourceFile fp $$ (sinkFile dest' :: Sink ByteString (ResourceT IO) ()) - copyBuiltInHaddocks :: FilePath -> IO () copyBuiltInHaddocks docdir = do mghc <- findExecutable "ghc" @@ -453,3 +507,52 @@ copyBuiltInHaddocks docdir = do src <- canonicalizePath (parent (fpFromString ghc) "../share/doc/ghc/html/libraries") copyDir src docdir + +------------- Previous results + +-- | The previous actions that can be run +data ResultType = Build | Haddock | Test + deriving (Show, Enum, Eq, Ord, Bounded, Read) + +-- | The result generated on a previous run +data PrevResult = PRNoResult | PRSuccess | PRFailure + deriving (Show, Enum, Eq, Ord, Bounded, Read) + +-- | Check if we should rerun based on a PrevResult and the expected status +checkPrevResult :: PrevResult -> TestState -> Bool +checkPrevResult _ Don'tBuild = False +checkPrevResult PRNoResult _ = True +checkPrevResult PRSuccess _ = False +checkPrevResult PRFailure ExpectSuccess = True +checkPrevResult PRFailure _ = False + +withPRPath :: PerformBuild -> ResultType -> PackageIdentifier -> (FilePath -> IO a) -> IO a +withPRPath pb rt ident inner = do + createTree $ parent fp + inner fp + where + fp = pbPrevResDir pb fpFromString (show rt) fpFromText (display ident) + +successBS, failureBS :: ByteString +successBS = "success" +failureBS = "failure" + +getPreviousResult :: PerformBuild -> ResultType -> PackageIdentifier -> IO PrevResult +getPreviousResult w x y = withPRPath w x y $ \fp -> do + eres <- tryIO $ readFile fp + return $ case eres of + Right bs + | bs == successBS -> PRSuccess + | bs == failureBS -> PRFailure + _ -> PRNoResult + +savePreviousResult :: PerformBuild -> ResultType -> PackageIdentifier -> Bool -> IO () +savePreviousResult pb rt ident res = + withPRPath pb rt ident $ \fp -> writeFile fp $ + if res then successBS else failureBS + +deletePreviousResults :: PerformBuild -> PackageIdentifier -> IO () +deletePreviousResults pb name = + forM_ [minBound..maxBound] $ \rt -> + withPRPath pb rt name $ \fp -> + void $ tryIO $ removeFile fp diff --git a/Stackage/Prelude.hs b/Stackage/Prelude.hs index ab2187fc..28fff061 100644 --- a/Stackage/Prelude.hs +++ b/Stackage/Prelude.hs @@ -20,6 +20,9 @@ import Distribution.Version as X (Version (..), VersionRange) import Distribution.Version as X (withinRange) import qualified Distribution.Version as C +import Filesystem (createTree) +import Filesystem.Path (parent) +import qualified Filesystem.Path as F unPackageName :: PackageName -> Text unPackageName (PackageName str) = pack str @@ -101,3 +104,13 @@ topologicalSort toFinal toDeps = data TopologicalSortException key = NoEmptyDeps (Map key (Set key)) deriving (Show, Typeable) instance (Show key, Typeable key) => Exception (TopologicalSortException key) + +copyDir :: FilePath -> FilePath -> IO () +copyDir src dest = + runResourceT $ sourceDirectoryDeep False src $$ mapM_C go + where + src' = src "" + go fp = forM_ (F.stripPrefix src' fp) $ \suffix -> do + let dest' = dest suffix + liftIO $ createTree $ parent dest' + sourceFile fp $$ (sinkFile dest' :: Sink ByteString (ResourceT IO) ()) diff --git a/Stackage/ServerBundle.hs b/Stackage/ServerBundle.hs index 6cdf5cb4..5aedb090 100644 --- a/Stackage/ServerBundle.hs +++ b/Stackage/ServerBundle.hs @@ -7,21 +7,31 @@ module Stackage.ServerBundle , epochTime , bpAllPackages , docsListing + , createBundleV2 + , CreateBundleV2 (..) + , SnapshotType (..) + , writeIndexStyle + , DocMap + , PackageDocs (..) ) where import qualified Codec.Archive.Tar as Tar import qualified Codec.Archive.Tar.Entry as Tar import qualified Codec.Compression.GZip as GZip import qualified Data.Map as M +import Data.Aeson (ToJSON (..), (.=), object, FromJSON (..), (.:), withObject) +import System.IO.Temp (withTempDirectory) import qualified Data.Yaml as Y -import Filesystem (isFile) +import Filesystem (isFile, getWorkingDirectory, listDirectory, isDirectory, canonicalizePath) import Foreign.C.Types (CTime (CTime)) import Stackage.BuildConstraints import Stackage.BuildPlan import Stackage.Prelude +import System.IO.Temp (withTempDirectory) import qualified System.PosixCompat.Time as PC import qualified Text.XML as X import Text.XML.Cursor +import System.PosixCompat.Files (createSymbolicLink) -- | Get current time epochTime :: IO Tar.EpochTime @@ -73,13 +83,30 @@ serverBundle time title slug bp@BuildPlan {..} = GZip.compress $ Tar.write map (\(PackageName name) -> name) (M.keys $ siCorePackages bpSystemInfo) +-- | Package name is key +type DocMap = Map Text PackageDocs +data PackageDocs = PackageDocs + { pdVersion :: Text + , pdModules :: Map Text [Text] + -- ^ module name, path + } +instance ToJSON PackageDocs where + toJSON PackageDocs {..} = object + [ "version" .= pdVersion + , "modules" .= pdModules + ] +instance FromJSON PackageDocs where + parseJSON = withObject "PackageDocs" $ \o -> PackageDocs + <$> o .: "version" + <*> o .: "modules" + docsListing :: BuildPlan -> FilePath -- ^ docs directory - -> IO ByteString + -> IO DocMap docsListing bp docsDir = - fmap (Y.encode . fold) $ mapM go $ mapToList $ bpAllPackages bp + fmap fold $ mapM go $ mapToList $ bpAllPackages bp where - go :: (PackageName, Version) -> IO (Map Text Y.Value) + go :: (PackageName, Version) -> IO DocMap go (package, version) = do -- handleAny (const $ return mempty) $ do let dirname = fpFromText (concat [ display package @@ -107,8 +134,138 @@ docsListing bp docsDir = return $ if e then asMap $ singletonMap name [fpToText dirname, href] else mempty - return $ singletonMap (display package) $ Y.object - [ "version" Y..= display version - , "modules" Y..= m - ] + return $ singletonMap (display package) $ PackageDocs + { pdVersion = display version + , pdModules = m + } else return mempty + +data SnapshotType = STNightly + | STLTS !Int !Int -- ^ major, minor + deriving (Show, Read, Eq, Ord) + +instance ToJSON SnapshotType where + toJSON STNightly = object + [ "type" .= asText "nightly" + ] + toJSON (STLTS major minor) = object + [ "type" .= asText "lts" + , "major" .= major + , "minor" .= minor + ] +instance FromJSON SnapshotType where + parseJSON = withObject "SnapshotType" $ \o -> do + t <- o .: "type" + case asText t of + "nightly" -> return STNightly + "lts" -> STLTS + <$> o .: "major" + <*> o .: "minor" + _ -> fail $ "Unknown type for SnapshotType: " ++ unpack t + +data CreateBundleV2 = CreateBundleV2 + { cb2Plan :: BuildPlan + , cb2Type :: SnapshotType + , cb2DocsDir :: FilePath + , cb2Dest :: FilePath + } + +-- | Create a V2 bundle, which contains the build plan, metadata, docs, and doc +-- map. +createBundleV2 :: CreateBundleV2 -> IO () +createBundleV2 CreateBundleV2 {..} = do + docsDir <- canonicalizePath cb2DocsDir + docMap <- docsListing cb2Plan cb2DocsDir + + Y.encodeFile (fpToString $ docsDir "build-plan.yaml") cb2Plan + Y.encodeFile (fpToString $ docsDir "build-type.yaml") cb2Type + Y.encodeFile (fpToString $ docsDir "docs-map.yaml") docMap + void $ writeIndexStyle Nothing cb2DocsDir + + currentDir <- getWorkingDirectory + files <- listDirectory docsDir + + let args = "cfJ" + : fpToString (currentDir cb2Dest) + : "--dereference" + : map (fpToString . filename) files + cp = (proc "tar" args) { cwd = Just $ fpToString docsDir } + withCheckedProcess cp $ \ClosedStream Inherited Inherited -> return () + +writeIndexStyle :: Maybe Text -- ^ snapshot id + -> FilePath -- ^ docs dir + -> IO [String] +writeIndexStyle msnapid dir = do + dirs <- fmap sort + $ runResourceT + $ sourceDirectory dir + $$ filterMC (liftIO . isDirectory) + =$ mapC (fpToString . filename) + =$ sinkList + writeFile (dir "index.html") $ mkIndex + (unpack <$> msnapid) + dirs + writeFile (dir "style.css") styleCss + return dirs + +mkIndex :: Maybe String -> [String] -> String +mkIndex msnapid dirs = concat + [ "\nHaddocks index" + , "" + , "" + , "" + , "" + , "
" + , "
" + , "

Haddock documentation index

" + , flip foldMap msnapid $ \snapid -> concat + [ "

Return to snapshot

" + ] + , "
    " + , concatMap toLI dirs + , "
" + ] + where + toLI name = concat + [ "
  • " + , name + , "
  • " + ] + +styleCss :: String +styleCss = concat + [ "@media (min-width: 530px) {" + , "ul { -webkit-column-count: 2; -moz-column-count: 2; column-count: 2 }" + , "}" + , "@media (min-width: 760px) {" + , "ul { -webkit-column-count: 3; -moz-column-count: 3; column-count: 3 }" + , "}" + , "ul {" + , " margin-left: 0;" + , " padding-left: 0;" + , " list-style-type: none;" + , "}" + , "body {" + , " background: #f0f0f0;" + , " font-family: 'Lato', sans-serif;" + , " text-shadow: 1px 1px 1px #ffffff;" + , " font-size: 20px;" + , " line-height: 30px;" + , " padding-bottom: 5em;" + , "}" + , "h1 {" + , " font-weight: normal;" + , " color: #06537d;" + , " font-size: 45px;" + , "}" + , ".return a {" + , " color: #06537d;" + , " font-style: italic;" + , "}" + , ".return {" + , " margin-bottom: 1em;" + , "}"] diff --git a/Stackage/Upload.hs b/Stackage/Upload.hs index c3e544e4..64d21094 100644 --- a/Stackage/Upload.hs +++ b/Stackage/Upload.hs @@ -14,17 +14,26 @@ module Stackage.Upload , uploadHackageDistroNamed , UploadDocMap (..) , uploadDocMap + , uploadBundleV2 + , UploadBundleV2 (..) + , def + , StackageServer + , unStackageServer ) where import Control.Monad.Writer.Strict (execWriter, tell) import Data.Default.Class (Default (..)) +import Data.Function (fix) import Filesystem (isDirectory, isFile) import Network.HTTP.Client +import qualified Network.HTTP.Client.Conduit as HCC import Network.HTTP.Client.MultipartFormData import Stackage.BuildPlan (BuildPlan) import Stackage.Prelude -import Stackage.ServerBundle (bpAllPackages, docsListing) +import Stackage.ServerBundle (bpAllPackages, docsListing, writeIndexStyle) import System.IO.Temp (withSystemTempFile) +import qualified System.IO as IO +import qualified Data.Yaml as Y newtype StackageServer = StackageServer { unStackageServer :: Text } deriving (Show, Eq, Ord, Hashable, IsString) @@ -107,17 +116,7 @@ uploadDocs (UploadDocs (StackageServer host) fp0 token ident) man = do where uploadDocsDir = withSystemTempFile "haddocks.tar.xz" $ \fp h -> do hClose h - dirs <- fmap sort - $ runResourceT - $ sourceDirectory fp0 - $$ filterMC (liftIO . isDirectory) - =$ mapC (fpToString . filename) - =$ sinkList - writeFile (fp0 "index.html") $ mkIndex - (unpack $ unSnapshotIdent ident) - dirs - writeFile (fp0 "style.css") styleCss - -- FIXME write index.html, style.css + dirs <- writeIndexStyle (Just $ unSnapshotIdent ident) fp0 let cp = (proc "tar" $ "cJf" : fp : "index.html" : "style.css" : dirs) { cwd = Just $ fpToString fp0 } @@ -201,7 +200,7 @@ uploadDocMap :: UploadDocMap -> Manager -> IO (Response LByteString) uploadDocMap UploadDocMap {..} man = do docmap <- docsListing udmPlan udmDocDir req1 <- parseUrl $ unpack $ unStackageServer udmServer ++ "/upload-doc-map" - req2 <- formDataBody (formData docmap) req1 + req2 <- formDataBody (formData $ Y.encode docmap) req1 let req3 = req2 { method = "PUT" , requestHeaders = @@ -219,61 +218,55 @@ uploadDocMap UploadDocMap {..} man = do , partFileRequestBody "docmap" "docmap" $ RequestBodyBS docmap ] -mkIndex :: String -> [String] -> String -mkIndex snapid dirs = concat - [ "\nHaddocks index" - , "" - , "" - , "" - , "" - , "
    " - , "
    " - , "

    Haddock documentation index

    " - , "

    Return to snapshot

      " - , concatMap toLI dirs - , "
    " - ] - where - toLI name = concat - [ "
  • " - , name - , "
  • " - ] +data UploadBundleV2 = UploadBundleV2 + { ub2Server :: StackageServer + , ub2AuthToken :: Text + , ub2Bundle :: FilePath + } -styleCss :: String -styleCss = concat - [ "@media (min-width: 530px) {" - , "ul { -webkit-column-count: 2; -moz-column-count: 2; column-count: 2 }" - , "}" - , "@media (min-width: 760px) {" - , "ul { -webkit-column-count: 3; -moz-column-count: 3; column-count: 3 }" - , "}" - , "ul {" - , " margin-left: 0;" - , " padding-left: 0;" - , " list-style-type: none;" - , "}" - , "body {" - , " background: #f0f0f0;" - , " font-family: 'Lato', sans-serif;" - , " text-shadow: 1px 1px 1px #ffffff;" - , " font-size: 20px;" - , " line-height: 30px;" - , " padding-bottom: 5em;" - , "}" - , "h1 {" - , " font-weight: normal;" - , " color: #06537d;" - , " font-size: 45px;" - , "}" - , ".return a {" - , " color: #06537d;" - , " font-style: italic;" - , "}" - , ".return {" - , " margin-bottom: 1em;" - , "}"] +uploadBundleV2 :: UploadBundleV2 -> Manager -> IO Text +uploadBundleV2 UploadBundleV2 {..} man = IO.withBinaryFile (fpToString ub2Bundle) IO.ReadMode $ \h -> do + size <- IO.hFileSize h + putStrLn $ "Bundle size: " ++ tshow size + req1 <- parseUrl $ unpack $ unStackageServer ub2Server ++ "/upload2" + let req2 = req1 + { method = "PUT" + , requestHeaders = + [ ("Authorization", encodeUtf8 ub2AuthToken) + , ("Accept", "application/json") + , ("Content-Type", "application/x-tar") + ] + , requestBody = HCC.requestBodySource (fromIntegral size) + $ sourceHandle h $= printProgress size + } + sink = decodeUtf8C =$ fix (\loop -> do + mx <- peekC + case mx of + Nothing -> error $ "uploadBundleV2: premature end of stream" + Just _ -> do + l <- lineC $ takeCE 4096 =$ foldC + let (cmd, msg') = break (== ':') l + msg = dropWhile (== ' ') $ dropWhile (== ':') msg' + case cmd of + "CONT" -> do + putStrLn msg + loop + "FAILURE" -> error $ "uploadBundleV2 failed: " ++ unpack msg + "SUCCESS" -> return msg + _ -> error $ "uploadBundleV2: unknown command " ++ unpack cmd + ) + withResponse req2 man $ \res -> HCC.bodyReaderSource (responseBody res) $$ sink + where + printProgress total = + loop 0 0 + where + loop sent lastPercent = + await >>= maybe (putStrLn "Upload complete") go + where + go bs = do + yield bs + let sent' = sent + fromIntegral (length bs) + percent = sent' * 100 `div` total + when (percent /= lastPercent) + $ putStrLn $ "Upload progress: " ++ tshow percent ++ "%" + loop sent' percent diff --git a/app/stackage.hs b/app/stackage.hs index 8fdd2833..75e83108 100644 --- a/app/stackage.hs +++ b/app/stackage.hs @@ -10,7 +10,11 @@ import Options.Applicative import Filesystem.Path.CurrentOS (decodeString) import Paths_stackage (version) import Stackage.CompleteBuild +import Stackage.Upload import Stackage.InstallBuild +import Network.HTTP.Client (withManager) +import Network.HTTP.Client.TLS (tlsManagerSettings) +import qualified Data.Text as T main :: IO () main = @@ -62,7 +66,13 @@ main = installBuild installFlags "install" - "Install a snapshot from an existing build plan"] + "Install a snapshot from an existing build plan" + , cmnd + uploadv2 + uploadv2Flags + "upload2" + "Upload a pre-existing v2 bundle" + ] cmnd exec parse name desc = command name $ @@ -77,6 +87,11 @@ main = (switch (long "skip-tests" <> help "Skip build and running the test suites")) <*> + fmap + not + (switch + (long "skip-haddock" <> + help "Skip generating haddock documentation")) <*> fmap not (switch @@ -85,12 +100,23 @@ main = switch (long "enable-library-profiling" <> help "Enable profiling when building") <*> + switch + (long "enable-executable-dynamic" <> + help "Enable dynamic executables when building") <*> switch (long "verbose" <> short 'v' <> help "Output verbose detail about the build steps") <*> switch (long "skip-check" <> - help "Skip the check phase, and pass --allow-newer to cabal configure") + help "Skip the check phase, and pass --allow-newer to cabal configure") <*> + switch + (long "upload-v1" <> + help "Use the V1 upload code") <*> + (fmap fromString (strOption + (long "server-url" <> + metavar "SERVER-URL" <> + showDefault <> value (T.unpack $ unStackageServer def) <> + help "Server to upload bundle to"))) nightlyUploadFlags = fromString <$> strArgument (metavar "DATE" <> @@ -136,12 +162,39 @@ main = (switch (long "skip-tests" <> help "Skip build and running the test suites")) <*> + fmap + not + (switch + (long "skip-haddock" <> + help "Skip generating haddock documentation")) <*> switch (long "enable-library-profiling" <> help "Enable profiling when building") <*> + switch + (long "enable-executable-dynamic" <> + help "Enable dynamic executables when building") <*> switch (long "verbose" <> short 'v' <> help "Output verbose detail about the build steps") <*> switch (long "skip-check" <> help "Skip the check phase, and pass --allow-newer to cabal configure") + + uploadv2 (path, url) = withManager tlsManagerSettings $ \man -> do + token <- getStackageAuthToken + res <- flip uploadBundleV2 man UploadBundleV2 + { ub2AuthToken = token + , ub2Server = fromString url + , ub2Bundle = decodeString path + } + putStrLn $ "New URL: " ++ T.unpack res + + uploadv2Flags = (,) + <$> (strArgument + (metavar "BUNDLE-PATH" <> + help "Bundle path")) + <*> strOption + (long "server-url" <> + metavar "SERVER-URL" <> + showDefault <> value (T.unpack $ unStackageServer def) <> + help "Server to upload bundle to") diff --git a/build-constraints.yaml b/build-constraints.yaml index 74b60e4b..ce127ee5 100644 --- a/build-constraints.yaml +++ b/build-constraints.yaml @@ -379,6 +379,7 @@ packages: - pipes - pipes-parse - pipes-concurrency + - pipes-safe "Chris Allen ": - bloodhound @@ -390,9 +391,12 @@ packages: - fay-jquery - fay-text - fay-uri - - fclabels - snaplet-fay + "Sebastiaan Visser ": + - clay + - fclabels + "Rodrigo Setti ": - messagepack - messagepack-rpc @@ -473,7 +477,8 @@ packages: - openpgp-asciiarmor - MusicBrainz - DAV - - hopenpgp-tools + # https://github.com/fpco/stackage/issues/463 + #- hopenpgp-tools # https://github.com/fpco/stackage/issues/160 "Ketil Malde": @@ -503,9 +508,9 @@ packages: - code-builder - fay-builder - generic-aeson + - generic-xmlpickler - hxt-pickle-utils - imagesize-conduit - - imagesize-conduit - json-schema - multipart - regular-xmlpickler @@ -518,8 +523,6 @@ packages: - rest-types - rest-wai - tostring - - tostring - - uri-encode - uri-encode "Simon Michael ": @@ -529,7 +532,10 @@ packages: - io-manager "Dimitri Sabadie ": - ghc-syb-utils @@ -574,6 +580,7 @@ packages: - haddock-api - here - hlibgit2 + - gitlib-libgit2 - hostname-validate - interpolatedstring-perl6 - iproute @@ -612,6 +619,9 @@ packages: - Spock - Spock-digestive - Spock-worker + - users + - users-test + - users-postgresql-simple "Joey Eremondi ": - aeson-pretty @@ -641,6 +651,11 @@ packages: "Samplecount stefan@samplecount.com @kaoskorobase": - shake-language-c + "Marcin Mrotek ": + - diagrams-hsqml + - type-list + - vinyl-utils + "Marcin Mrotek ": - type-list @@ -703,19 +718,37 @@ packages: "Gabríel Arthúr Pétursson gabriel@system.is": - sdl2 - "Stackage upper bounds": + "Leon Mergen leon@solatis.com @solatis": + - network-attoparsec + - network-anonymous-i2p - # https://github.com/fpco/stackage/issues/291 - - random < 1.0.1.3 + "Timothy Jones git@zmthy.io @zmthy": + - cabal-test-quickcheck + - http-media + + "Greg V greg@unrelenting.technology @myfreeweb": + - gitson + - pcre-heavy + + "Francesco Mazzoli f@mazzo.li @bitonic": + - language-c-quote + + "Sönke Hahn soenkehahn@gmail.com @soenkehahn": + - string-conversions + + "Oleg Grenrus oleg.grenrus@iki.fi @phadej": + - waitra + + "Adam C. Foltzer acfoltzer@galois.com @acfoltzer": + - gitrev + + "Stackage upper bounds": # https://github.com/fpco/stackage/issues/390 # NOTE: When this issue is resolved, remove the expected test failure # for language-ecmascript as well. - language-ecmascript < 0.17 - # https://github.com/fpco/stackage/issues/402 - - vector-space < 0.9 - # https://github.com/fpco/stackage/issues/407 - HStringTemplate < 0.8 @@ -731,22 +764,32 @@ packages: # https://github.com/fpco/stackage/issues/426 - utf8-string < 1 - # https://github.com/d12frosted/CanonicalPath/issues/3 - - system-canonicalpath < 0.3 - # https://github.com/fpco/stackage/issues/440 - th-orphans < 0.9 - file-location < 0.4.7 + - th-desugar < 1.5.1 # https://github.com/fpco/stackage/issues/442 - blaze-builder < 0.4 + - blaze-markup < 0.7 + - blaze-html < 0.8 # https://github.com/fpco/stackage/issues/443 - exceptions < 0.7 - - resourcet < 1.1.4 + - rest-client < 0.5 + - rest-types < 1.13 + - rest-core < 0.35 + - rest-gen < 0.17 + - rest-wai < 0.1.0.7 - # https://github.com/fpco/stackage/issues/445 - - semigroupoids < 4.3 + # https://github.com/fpco/stackage/issues/467 + - lens < 4.8 + + # https://github.com/fpco/stackage/issues/476 + - vector-space < 0.10 + + # https://github.com/ekmett/linear/issues/70 + - linear < 1.18 # Package flags are applied to individual packages, and override the values of # global-flags @@ -918,9 +961,6 @@ expected-test-failures: # https://github.com/BioHaskell/octree/issues/4 - Octree - # https://github.com/goldfirere/th-desugar/issues/12 - - th-desugar - # https://github.com/jmillikin/haskell-filesystem/issues/3 - system-filepath @@ -993,20 +1033,52 @@ expected-test-failures: # https://github.com/haskell-distributed/distributed-process-execution/issues/2 - distributed-process-execution + # Seems to depend on mtl being installed in user package database, which + # isn't always the case (e.g., build server) + - happy + + # https://github.com/jberryman/directory-tree/issues/4 + - directory-tree + + # https://github.com/zmthy/http-media/issues/11 + - http-media + + # https://github.com/ekmett/semigroupoids/issues/18 + - semigroupoids + + # https://github.com/ndmitchell/hoogle/issues/101 + - hoogle + + # https://github.com/myfreeweb/gitson/issues/1 + - gitson + + # https://github.com/jcristovao/enclosed-exceptions/issues/6 + - enclosed-exceptions + + # Expects a running PostgreSQL server + - users-postgresql-simple + + # Problems with linking with system libraries on Ubuntu 12.04 + - nettle + + # Requires locally running services + - network-anonymous-i2p + # Haddocks which are expected to fail. Same concept as expected test failures. expected-haddock-failures: # https://github.com/acw/bytestring-progress/issues/4 - bytestring-progress - # https://github.com/ekmett/gl/issues/4 - - gl - # https://github.com/leventov/yarr/issues/5 - yarr # https://github.com/wereHamster/rethinkdb-client-driver/issues/1 - rethinkdb-client-driver + # Requires build before haddock, which doesn't always happen in incremental + # builds. Could consider special-casing this requirement. + - gtk + # Benchmarks which should not be built. Note that Stackage does *not* generally # build benchmarks. The difference here will be whether dependencies for these # benchmarks are included or not. diff --git a/debian-bootstrap.sh b/debian-bootstrap.sh index c069dcb1..827e8460 100755 --- a/debian-bootstrap.sh +++ b/debian-bootstrap.sh @@ -18,6 +18,9 @@ apt-get install -y \ build-essential \ libncurses-dev \ git \ + wget \ + m4 \ + texlive-full \ libgmp3c2 \ libgmp3-dev \ zlib1g-dev \ @@ -34,11 +37,11 @@ apt-get install -y \ llvm \ libbz2-dev \ libjudy-dev \ + libsqlite3-dev \ libmysqlclient-dev \ libpq-dev \ libicu-dev \ libssl-dev \ - nettle-dev \ libgsl0-dev \ libblas-dev \ liblapack-dev \ @@ -49,4 +52,20 @@ apt-get install -y \ libyaml-dev \ liblzma-dev \ libsdl2-dev \ + libxss-dev \ libzmq3-dev + +mkdir /tmp/nettle-build +( +cd /tmp/nettle-build +wget https://ftp.gnu.org/gnu/nettle/nettle-2.7.1.tar.gz +tar zxf nettle-2.7.1.tar.gz +cd nettle-2.7.1 +./configure --prefix=/usr +make +make install + +mkdir -p /usr/lib/x86_64-linux-gnu/ +ln -sfv /usr/lib/libnettle.so.4.7 /usr/lib/x86_64-linux-gnu/libnettle.so.4 +) +rm -rf /tmp/nettle-build diff --git a/stackage.cabal b/stackage.cabal index 94b42da9..d12c172b 100644 --- a/stackage.cabal +++ b/stackage.cabal @@ -1,5 +1,5 @@ name: stackage -version: 0.5.2 +version: 0.6.0.1 synopsis: "Stable Hackage," tools for creating a vetted set of packages from Hackage. description: Please see for a description and documentation. homepage: https://github.com/fpco/stackage @@ -23,6 +23,7 @@ library Stackage.BuildPlan Stackage.CheckBuildPlan Stackage.UpdateBuildPlan + Stackage.GhcPkg Stackage.GithubPings Stackage.InstallBuild Stackage.PackageDescription @@ -54,6 +55,7 @@ library , yaml , unix-compat , http-client + , http-conduit , http-client-tls , temporary , data-default-class @@ -63,6 +65,7 @@ library , streaming-commons >= 0.1.7.1 , semigroups , xml-conduit + , conduit executable stackage default-language: Haskell2010 @@ -72,6 +75,9 @@ executable stackage , stackage , optparse-applicative >= 0.11 , system-filepath + , http-client + , http-client-tls + , text ghc-options: -rtsopts -threaded -with-rtsopts=-N test-suite spec