fix request body and unzip once uploaded

This commit is contained in:
Lucy Cifferello
2022-09-14 15:46:12 -06:00
parent ff90f65b3c
commit 3c4f3a6a0b
2 changed files with 6 additions and 5 deletions

View File

@@ -614,8 +614,8 @@ eosUpload (EosUpload name img version) = do
sourceFile img
.| gzip
.| sinkFileCautious compressedFilePath
gSize <- getFileSize compressedFilePath
bar <- newProgressBar defStyle 30 (Progress 0 (fromIntegral gSize) ())
compressedSize <- getFileSize compressedFilePath
bar <- newProgressBar defStyle 30 (Progress 0 (fromIntegral compressedSize) ())
body <- observedStreamFile (updateProgress bar . const . sfs2prog) $ compressedFilePath
let withBody = setRequestBody body noBody
let withQParams =
@@ -623,9 +623,9 @@ eosUpload (EosUpload name img version) = do
[("version", Just $ show version), ("hash", Just $ convertToBase Base16 hash)]
withBody
-- let withSource = setRequestBodySource (fromIntegral size) _ withQParams
let req = setRequestBodyFile compressedFilePath withQParams
-- let req = setRequestBodyFile compressedFilePath withQParams
manager <- newTlsManager
res <- runReaderT (httpLbs req) manager
res <- runReaderT (httpLbs withQParams) manager
removeFile $ compressedFilePath
if getResponseStatus res == status200
then -- no output is successful

View File

@@ -23,6 +23,7 @@ import Data.Aeson (
(.:?),
(.=),
)
import Data.Conduit.Zlib (ungzip)
import Data.HashMap.Internal.Strict (
HashMap,
differenceWith,
@@ -150,7 +151,7 @@ postPkgUploadR = do
createDirectoryIfMissing True resourcesTemp
withTempDirectory resourcesTemp "newpkg" $ \dir -> do
let path = dir </> "temp" <.> "s9pk"
runConduit $ rawRequestBody .| sinkFile path
runConduit $ rawRequestBody .| ungzip .| sinkFile path
pool <- getsYesod appConnPool
PkgRepo{..} <- ask
res <- retry $ extractPkg pool path