haskell/stackage-server
1
0
Fork 0
mirror of https://github.com/commercialhaskell/stackage-server.git synced 2026-01-24 09:51:57 +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

22
Stackage/Database/Cron.hs
View File

@ -22,7 +22,8 @@ import Network.HTTP.Types (status200)
import Data.Streaming.Network (bindPortTCP) 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
snapshots <- runReaderT snapshotsJSON db do
withSystemTempFile "snapshots.json" $ \fp h -> do snapshots <- runReaderT snapshotsJSON db
L.hPut h $ A.encode snapshots let key = "snapshots.json" :: Text
hClose h po =
upload (fpFromString fp) "snapshots.json" set poACL (Just PublicRead)
$ 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