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

View File

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