From cb0dabfcadbbbd40dea86801842e4de57ea23c66 Mon Sep 17 00:00:00 2001 From: Matthias Heinzel Date: Fri, 9 Jun 2017 03:36:05 +0200 Subject: [PATCH 1/3] Simplify function for showing MegaByte values --- src/Lib.hs | 3 +-- src/Utils.hs | 8 +++++--- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/src/Lib.hs b/src/Lib.hs index e8c515f..4e8ce71 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -1164,12 +1164,11 @@ downloadBinary s3BucketName objectRemotePath objectName = do printProgress :: MonadIO m => String -> Int -> C.Conduit BS.ByteString m BS.ByteString printProgress objName totalLength = loop totalLength 0 0 where - roundedSizeInMB = roundBytesToMegabytes totalLength loop t consumedLen lastLen = C.await >>= maybe (return ()) (\bs -> do let len = consumedLen + BS.length bs let diffGreaterThan1MB = len - lastLen >= 1024*1024 when ( diffGreaterThan1MB || len == t) $ - sayLnWithTime $ "Downloaded " ++ show (roundBytesToMegabytes len) ++ " MB of " ++ show roundedSizeInMB ++ " MB for " ++ objName + sayLnWithTime $ "Downloaded " ++ showInMegabytes len ++ " of " ++ showInMegabytes totalLength ++ " for " ++ objName C.yield bs let a = if diffGreaterThan1MB then len else lastLen loop t len a) diff --git a/src/Utils.hs b/src/Utils.hs index 2f92a38..5350003 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -30,6 +30,7 @@ import qualified Network.AWS as AWS (Error, ErrorMessage (..), _ServiceError) import Network.HTTP.Conduit as HTTP import Network.HTTP.Types.Header as HTTP (hUserAgent) +import Numeric (showFFloat) import System.FilePath import Text.Read (readMaybe) import Types @@ -97,10 +98,11 @@ sayLnWithTime line = do --- | Given a number n representing bytes, gives an approximation in Megabytes. -roundBytesToMegabytes :: Integral n => n -> Double -roundBytesToMegabytes n = fromInteger (round (nInMB * (10^2))) / (10.0^^2) +-- | Given a number n representing bytes, shows it in MB, rounded to 2 decimal places. +showInMegabytes :: Integral n => n -> String +showInMegabytes n = showFFloat (Just 2) nInMB " MB" where + nInMB :: Double nInMB = fromIntegral n / (1024*1024) From 4586de49cc6a4a61dac507dc3d9551bf88a40c05 Mon Sep 17 00:00:00 2001 From: Matthias Heinzel Date: Fri, 9 Jun 2017 03:44:32 +0200 Subject: [PATCH 2/3] Add type signature to uploadBinary --- src/Lib.hs | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/src/Lib.hs b/src/Lib.hs index 4e8ce71..fde817a 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -403,11 +403,8 @@ uploadFrameworkToS3 frameworkArchive s3BucketName reverseRomeMap (FrameworkVersion f@(FrameworkName fwn) version) - platform = do - (env, verbose) <- ask - runReaderT - (uploadBinary s3BucketName (Zip.fromArchive frameworkArchive) remoteFrameworkUploadPath fwn) - (env, verbose) + platform = + uploadBinary s3BucketName (Zip.fromArchive frameworkArchive) remoteFrameworkUploadPath fwn where remoteFrameworkUploadPath = remoteFrameworkPath platform reverseRomeMap f version @@ -425,9 +422,8 @@ uploadDsymToS3 dSYMArchive s3BucketName reverseRomeMap (FrameworkVersion f@(FrameworkName fwn) version) - platform = do - (env, verbose) <- ask - runReaderT (uploadBinary s3BucketName (Zip.fromArchive dSYMArchive) remoteDsymUploadPath (fwn ++ ".dSYM")) (env, verbose) + platform = + uploadBinary s3BucketName (Zip.fromArchive dSYMArchive) remoteDsymUploadPath (fwn ++ ".dSYM") where remoteDsymUploadPath = remoteDsymPath platform reverseRomeMap f version @@ -611,6 +607,12 @@ zipDir dir verbose = do -- | Uploads an artificat to an `S3.BucketName` at a given path in the bucket. +uploadBinary :: AWS.ToBody a + => S3.BucketName + -> a + -> FilePath + -> FilePath + -> ReaderT (AWS.Env, Bool) IO () uploadBinary s3BucketName binaryZip destinationPath objectName = do (env, verbose) <- ask let objectKey = S3.ObjectKey $ T.pack destinationPath From c7d49d83fb65e915e280d3d3708b5e3ede25442b Mon Sep 17 00:00:00 2001 From: Matthias Heinzel Date: Fri, 9 Jun 2017 03:48:16 +0200 Subject: [PATCH 3/3] Add type signature to downloadBinary --- src/Lib.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Lib.hs b/src/Lib.hs index fde817a..d76e3c8 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -1147,6 +1147,10 @@ getVersionFileFromS3 s3BucketName gitRepoNameAndVersion = -- | Downloads an artificat stored at a given path from an `S3.BucketName`. +downloadBinary :: S3.BucketName + -> FilePath + -> FilePath + -> ExceptT String (ReaderT (AWS.Env, Bool) IO) LBS.ByteString downloadBinary s3BucketName objectRemotePath objectName = do (env, verbose) <- ask runResourceT . AWS.runAWS env $ do