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

Fix snapshots.json uploading

Browse Source
This commit is contained in:
Michael Snoyman 2015-06-23 11:34:26 +03:00
parent 8f20a226fe
commit 2d90945853
1 changed files with 13 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
Stackage/Database/Cron.hs
View File

@ -23,6 +23,7 @@ import Data.Streaming.Network (bindPortTCP)
import Network.AWS (Credentials (Discover), import Network.AWS (Credentials (Discover),
Region (NorthVirginia), getEnv, Region (NorthVirginia), getEnv,
send, sourceFileIO, envManager) send, sourceFileIO, envManager)
import Network.AWS.Data (toBody)
import Network.AWS.S3 (ObjectCannedACL (PublicRead), import Network.AWS.S3 (ObjectCannedACL (PublicRead),
poACL, poACL,
putObject) putObject)
@ -31,9 +32,6 @@ import qualified Data.Conduit.Binary as CB
import Data.Conduit.Zlib (WindowBits (WindowBits), import Data.Conduit.Zlib (WindowBits (WindowBits),
compress, ungzip) compress, ungzip)
import qualified Hoogle import qualified Hoogle
import System.IO.Temp (withSystemTempFile)
import qualified Data.Aeson as A
import qualified Data.ByteString.Lazy as L
filename' :: Text filename' :: Text
filename' = concat filename' = concat
@ -167,11 +165,17 @@ stackageServerCron = do
db <- openStackageDatabase dbfp db <- openStackageDatabase dbfp
do
snapshots <- runReaderT snapshotsJSON db snapshots <- runReaderT snapshotsJSON db
withSystemTempFile "snapshots.json" $ \fp h -> do let key = "snapshots.json" :: Text
L.hPut h $ A.encode snapshots po =
hClose h set poACL (Just PublicRead)
upload (fpFromString fp) "snapshots.json" $ putObject (toBody snapshots) "haddock.stackage.org" key
putStrLn $ "Uploading: " ++ key
eres <- runResourceT $ send env po
case eres of
Left e -> error $ show (key, e)
Right _ -> putStrLn "Success"
names <- runReaderT last5Lts5Nightly db names <- runReaderT last5Lts5Nightly db
let manager = view envManager env let manager = view envManager env