haskell/stackage-server
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage-server.git synced 2026-01-12 12:18:29 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

Less lazy I/O (use tar command line tool)

Browse Source
This commit is contained in:
Michael Snoyman 2014-05-12 08:48:13 +03:00
parent 68f7abff47
commit 7e3abca045
4 changed files with 21 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Application.hs
View File

@ -134,7 +134,7 @@ makeFoundation conf = do
runDB' = runResourceT . flip (Database.Persist.runPool dbconf) p
uploadHistory0 <- runDB' $ selectSource [] [] $$ sinkUploadHistory
UploadState uploadHistory newUploads <- loadCabalFiles uploadHistory0
runDB' $ mapM_ insert newUploads
runDB' $ mapM_ insert_ newUploads
let views =
[ ("pvp", viewPVP uploadHistory)
, ("no-bounds", viewNoBounds)

2
Handler/Aliases.hs
View File

@ -10,7 +10,7 @@ putAliasesR = do
aliases <- mapM (parseAlias uid) $ lines aliasesText
runDB $ do
deleteWhere [AliasUser ==. uid]
mapM_ insert aliases
mapM_ insert_ aliases
setMessage "Aliases updated"
redirect ProfileR

22
Handler/UploadStackage.hs
View File

@ -18,6 +18,8 @@ import Control.Monad.State.Strict (execStateT, get, put)
import qualified Codec.Compression.GZip as GZip
import Control.Monad.Trans.Resource (unprotect, allocate)
import System.Directory (removeFile, getTemporaryDirectory)
import System.Process (runProcess, waitForProcess)
import System.Exit (ExitCode (ExitSuccess))
fileKey :: Text
fileKey = "stackage"
@ -81,12 +83,22 @@ putUploadStackageR = do
, lsFiles = mempty
, lsIdent = ident
}
entries <- liftIO $ Tar.pack dir $ map fpToString $ setToList files
let indexLBS = GZip.compress $ Tar.write entries
sourceLazy indexLBS $$ storeWrite (CabalIndex ident)
runDB $ insert stackage
withSystemTempFile "newindex" $ \fp h -> do
ec <- liftIO $ do
hClose h
let args = "cfz"
: fp
: map fpToString (setToList files)
ph <- runProcess "tar" args (Just dir) Nothing Nothing Nothing Nothing
waitForProcess ph
if ec == ExitSuccess
then do
sourceFile (fpFromString fp) $$ storeWrite (CabalIndex ident)
runDB $ insert stackage
done "Stackage created" $ StackageHomeR ident
done "Stackage created" $ StackageHomeR ident
else do
done "Error creating index file" ProfileR
redirect $ ProgressR key
where

3
stackage-server.cabal
View File

@ -93,7 +93,7 @@ library
, fast-logger >= 2.1.4 && < 2.2
, wai >= 2.1 && < 2.2
, wai-logger >= 2.1 && < 2.2
, classy-prelude-yesod >= 0.9 && < 0.9.1
, classy-prelude-yesod >= 0.9.2 && < 0.9.3
, mwc-random >= 0.13 && < 0.14
, mtl >= 2.1 && < 2.2
, blaze-markup >= 0.6 && < 0.7
@ -119,6 +119,7 @@ library
, lifted-base
, mono-traversable
, time
, process
executable stackage-server
if flag(library-only)