unzipped in wrong fn; cleanup

This commit is contained in:
Lucy Cifferello
2022-09-14 15:53:12 -06:00
parent 3c4f3a6a0b
commit 73e0a84142
2 changed files with 4 additions and 4 deletions

View File

@@ -597,13 +597,14 @@ upload (Upload name mpkg shouldIndex) = do
-- stream zip file
-- stream zip into request body
-- store on server uncomressed?
-- nice to have: progress for hashing
eosUpload :: EosUpload -> IO ()
eosUpload (EosUpload name img version) = do
PublishCfgRepo{..} <- findNameInCfg name
noBody <-
parseRequest ("POST " <> show publishCfgRepoLocation <> "/admin/v0/eos-upload")
<&> setRequestHeaders [("accept", "text/plain")]
<&> setRequestHeaders [("Content-Type", "application/octet-stream")]
-- <&> setRequestHeaders [("Content-Type", "application/octet-stream")]
<&> setRequestHeaders [("Content-Encoding", "gzip")]
<&> applyBasicAuth (B8.pack publishCfgRepoUser) (B8.pack publishCfgRepoPass)
hash <- hashFile @_ @SHA256 img
@@ -623,7 +624,6 @@ 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
manager <- newTlsManager
res <- runReaderT (httpLbs withQParams) manager
removeFile $ compressedFilePath

View File

@@ -151,7 +151,7 @@ postPkgUploadR = do
createDirectoryIfMissing True resourcesTemp
withTempDirectory resourcesTemp "newpkg" $ \dir -> do
let path = dir </> "temp" <.> "s9pk"
runConduit $ rawRequestBody .| ungzip .| sinkFile path
runConduit $ rawRequestBody .| sinkFile path
pool <- getsYesod appConnPool
PkgRepo{..} <- ask
res <- retry $ extractPkg pool path
@@ -193,7 +193,7 @@ postEosUploadR = do
createDirectoryIfMissing True resourcesTemp
withTempDirectory resourcesTemp "neweos" $ \dir -> do
let path = dir </> "eos" <.> "img"
runConduit $ rawRequestBody .| sinkFile path
runConduit $ rawRequestBody .| ungzip .| sinkFile path
void . runDB $ upsert (EosHash version hash) [EosHashHash =. hash]
let targetPath = root </> show version
removePathForcibly targetPath