From 3c4f3a6a0b9c7a885b1f665003d8a07c98aa24cf Mon Sep 17 00:00:00 2001
From: Lucy Cifferello <12953208+elvece@users.noreply.github.com>
Date: Wed, 14 Sep 2022 15:46:12 -0600
Subject: [PATCH] fix request body and unzip once uploaded

---
 src/Cli/Cli.hs       | 8 ++++----
 src/Handler/Admin.hs | 3 ++-
 2 files changed, 6 insertions(+), 5 deletions(-)

diff --git a/src/Cli/Cli.hs b/src/Cli/Cli.hs
index 70be6b1..f879cf6 100644
--- a/src/Cli/Cli.hs
+++ b/src/Cli/Cli.hs
@@ -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
diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs
index ea60877..3b93ec0 100644
--- a/src/Handler/Admin.hs
+++ b/src/Handler/Admin.hs
@@ -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